如何在Access VBA中读取非文本格式的剪贴板数据？

你可以直接通过Windows API操作剪贴板，完全不需要依赖MS Forms库或创建用户窗体/隐藏工作簿，避免额外开销。以下是针对文件、邮件附件的剪贴板读取实现：

核心思路 #

直接调用Windows剪贴板API，识别剪贴板中的CF_HDROP格式（这是复制文件/附件时系统使用的标准格式），解析出对应的文件路径列表。

完整VBA代码 #

Option Explicit

' Windows API声明
Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hwnd As LongPtr) As Boolean
Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Boolean
Private Declare PtrSafe Function EnumClipboardFormats Lib "user32.dll" (ByVal format As Long) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal format As Long) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As Boolean
Private Declare PtrSafe Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As LongPtr, ByVal iFile As Long, ByVal lpszFile As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileW" (ByVal hDrop As LongPtr, ByVal iFile As Long, ByVal lpszFile As String, ByVal cch As Long) As Long

' 剪贴板格式常量
Private Const CF_HDROP As Long = 15

' 获取剪贴板中的文件路径列表
Public Function GetClipboardFiles() As Collection
    Dim hDrop As LongPtr
    Dim fileCount As Long
    Dim i As Long
    Dim filePath As String
    Dim colFiles As New Collection
    
    ' 打开剪贴板
    If Not OpenClipboard(0&) Then
        Set GetClipboardFiles = colFiles
        Exit Function
    End If
    
    ' 查找CF_HDROP格式
    hDrop = GetClipboardData(CF_HDROP)
    If hDrop <> 0 Then
        ' 获取文件数量（传入-1返回数量）
        fileCount = DragQueryFile(hDrop, -1&, vbNullString, 0)
        
        ' 遍历每个文件
        For i = 0 To fileCount - 1
            ' 先获取路径长度
            filePath = String$(260, vbNullChar)
            If DragQueryFile(hDrop, i, filePath, Len(filePath)) > 0 Then
                filePath = Left$(filePath, InStr(filePath, vbNullChar) - 1)
                colFiles.Add filePath
            End If
        Next i
    End If
    
    ' 关闭剪贴板
    CloseClipboard
    
    Set GetClipboardFiles = colFiles
End Function

' 示例：按钮点击事件调用
Sub UseClipboardData_Click()
    Dim files As Collection
    Dim file As Variant
    
    Set files = GetClipboardFiles()
    
    If files.Count = 0 Then
        MsgBox "剪贴板中没有可识别的文件/附件", vbExclamation
        Exit Sub
    End If
    
    ' 处理获取到的文件（这里替换为你原有的拖放处理逻辑）
    For Each file In files
        Debug.Print "读取到文件：" & file
        ' 你的数据库处理代码，比如导入附件、关联记录等
    Next file
End Sub

代码说明 #

• API兼容性：使用PtrSafe声明，支持32位和64位Office版本。
• 无额外依赖：全程不涉及MS Forms库、用户窗体或隐藏工作簿，完全通过系统API实现。
• 支持多文件：可以一次性读取剪贴板中的多个文件/附件。
• 集成简单：直接在你的“使用剪贴板数据”按钮点击事件中调用UseClipboardData_Click，替换调试代码为你原有的拖放处理逻辑即可。

针对邮件本身的补充 #

如果需要读取复制的邮件（而非附件），可以识别剪贴板中的CF_FILEDESCRIPTOR或Outlook特定格式，不过需要额外的API解析。如果你的核心需求是文件/附件，上述代码已足够覆盖。

内容的提问来源于stack exchange，提问作者ecc450