CodeItBetter Programming Another VB Programming Blog

'System & API - Obtaining Clipboard Data using API (Can be used in VBA since there is no Clipboard Object in VBA)
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
 
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
 
Function ClipBoard_GetData()
    Dim hClipMemory As Long
    Dim lpClipMemory As Long
    Dim MyString As String
    Dim RetVal As Long
 
    If OpenClipboard(0&) = 0 Then
        MsgBox "Cannot open Clipboard. Another app. may have it open"
        Exit Function
    End If
 
    'Obtain the handle to the global memory block that is referencing the text.
    hClipMemory = GetClipboardData(CF_TEXT)
    If IsNull(hClipMemory) Then
        MsgBox "Could not allocate memory"
        GoTo OutOfHere
    End If
 
    'Lock Clipboard memory so we can reference the actual data string.
    lpClipMemory = GlobalLock(hClipMemory)
 
    If Not IsNull(lpClipMemory) Then
        MyString = Space$(MAXSIZE)
        RetVal = lstrcpy(MyString, lpClipMemory)
        RetVal = GlobalUnlock(hClipMemory)
        'Peel off the null terminating character.
        MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
    Else
        MsgBox "Could not lock memory to copy string from."
    End If
 
OutOfHere:
    RetVal = CloseClipboard()
    ClipBoard_GetData = MyString
End Function
 
'How can I call this function:
'Private Sub Main()
'    MsgBox ClipBoard_GetData()
'End Sub