Access VBA获取windows剪切板clipboard的内容

Access VBA获取已复制到windows剪切板clipboard的内容 

1.增加一个模板，粘贴以下代码

Option Compare Database

Declare Function abOpenClipboard Lib "User32" Alias "OpenClipboard" (ByVal Hwnd As Long) As Long
Declare Function abCloseClipboard Lib "User32" Alias "CloseClipboard" () As Long
Declare Function abEmptyClipboard Lib "User32" Alias "EmptyClipboard" () As Long
Declare Function abIsClipboardFormatAvailable Lib "User32" Alias "IsClipboardFormatAvailable" (ByVal wFormat As Long) As Long
Declare Function abSetClipboardData Lib "User32" Alias "SetClipboardData" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function abGetClipboardData Lib "User32" Alias "GetClipboardData" (ByVal wFormat As Long) As Long
Declare Function abGlobalAlloc Lib "Kernel32" Alias "GlobalAlloc" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function abGlobalLock Lib "Kernel32" Alias "GlobalLock" (ByVal hMem As Long) As Long
Declare Function abGlobalUnlock Lib "Kernel32" Alias "GlobalUnlock" (ByVal hMem As Long) As Boolean
Declare Function abLstrcpy Lib "Kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function abGlobalFree Lib "Kernel32" Alias "GlobalFree" (ByVal hMem As Long) As Long
Declare Function abGlobalSize Lib "Kernel32" Alias "GlobalSize" (ByVal hMem As Long) As Long
Const GHND = &H42
Const CF_TEXT = 1
Const APINULL = 0

Function Clipboard2Text()
    Dim wLen As Integer
    Dim hMemory As Long
    Dim hMyMemory As Long

    Dim lpMemory As Long
    Dim lpMyMemory As Long

    Dim retval As Variant
    Dim wFreeMemory As Boolean
    Dim wClipAvail As Integer
    Dim szText As String
    Dim wSize As Long

    If abIsClipboardFormatAvailable(CF_TEXT) = APINULL Then
        Clipboard2Text = Null
        Exit Function
    End If

    If abOpenClipboard(0&) = APINULL Then
        MsgBox "Unable to open Clipboard.  Perhaps some other application is using it."
        GoTo CB2T_Free
    End If

    hMemory = abGetClipboardData(CF_TEXT)
    If hMemory = APINULL Then
        MsgBox "无法从剪切板获取文本."
        Exit Function
    End If
    wSize = abGlobalSize(hMemory)
    szText = Space(wSize)

    wFreeMemory = True

    lpMemory = abGlobalLock(hMemory)
    If lpMemory = APINULL Then
        MsgBox "无法锁定剪切板内存."
        GoTo CB2T_Free
    End If

    ' Copy our string into the locked memory.
    retval = abLstrcpy(szText, lpMemory)
    ' Get rid of trailing stuff.
    szText = Trim(szText)
    ' Get rid of trailing 0.
    Clipboard2Text = Left(szText, Len(szText) - 1)
    wFreeMemory = False

CB2T_Close:
    If abCloseClipboard() = APINULL Then
        MsgBox "无法关闭剪切板."
    End If
    If wFreeMemory Then GoTo CB2T_Free
    Exit Function

CB2T_Free:
    If abGlobalFree(hMemory) <> APINULL Then
        MsgBox "无法释放剪切板内存."
    End If
End Function

2.调用

 Dim strText As String
 strText = Clipboard2Text
 
arr = Split(strText, Chr(13) + Chr(10))
For i = 0 To UBound(arr)
 Debug.Print arr(i)  '显示剪切板中每一行的内容
Next i