RDP会话中MS Access VBA无法获取本地复制的CF_HDROP格式剪贴板文件路径

在RDP远程会话里，从本地复制到远程的文件，并不会以标准的CF_HDROP格式存放在剪贴板中，而是用RDP专属的自定义格式：CF_RDP_FILEDESCRIPTOR（存储文件元数据）和CF_RDP_FILECONTENTS（存储文件内容）。这就是原代码在If Not CBool(IsClipboardFormatAvailable(CF_HDROP)) Then Exit Function处退出，但资源管理器能正常粘贴的原因。

以下是实现读取这类剪贴板文件的VBA代码：

1. 声明API与常量 #

在模块顶部添加以下声明：

Option Explicit

Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal wFormat As LongPtr) 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 LongPtr
Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32.dll" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As LongPtr
Private Declare PtrSafe Function GlobalSize Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)

Private Const CF_RDP_FILEDESCRIPTOR As String = "RDP File Descriptor"
Private Const CF_RDP_FILECONTENTS As String = "RDP File Contents"

Private Type RDP_FILE_DESCRIPTOR
    dwFlags As Long
    cFileName As Long
    ' 后续是文件名的Unicode字符串（cFileName指定长度）
End Type

2. 读取剪贴板中的RDP文件信息 #

添加以下函数，可获取剪贴板中来自本地的文件列表及内容：

Function GetRDPClipboardFiles() As Collection
    Dim colFiles As New Collection
    Dim hClipboard As LongPtr
    Dim fmtDescriptor As LongPtr, fmtContents As LongPtr
    Dim hMemDescriptor As LongPtr, pDescriptor As LongPtr
    Dim rdpFD As RDP_FILE_DESCRIPTOR
    Dim fileName As String
    Dim hMemContents As LongPtr, pContents As LongPtr
    Dim fileContent() As Byte
    Dim contentSize As Long
    
    ' 注册RDP剪贴板格式
    fmtDescriptor = RegisterClipboardFormat(CF_RDP_FILEDESCRIPTOR)
    fmtContents = RegisterClipboardFormat(CF_RDP_FILECONTENTS)
    
    ' 检查格式是否存在
    If fmtDescriptor = 0 Or fmtContents = 0 Then
        Set GetRDPClipboardFiles = colFiles
        Exit Function
    End If
    
    ' 打开剪贴板
    hClipboard = OpenClipboard(0&)
    If hClipboard = 0 Then
        Set GetRDPClipboardFiles = colFiles
        Exit Function
    End If
    
    ' 获取文件描述符数据
    hMemDescriptor = GetClipboardData(fmtDescriptor)
    If hMemDescriptor <> 0 Then
        pDescriptor = GlobalLock(hMemDescriptor)
        If pDescriptor <> 0 Then
            ' 读取文件描述符结构
            CopyMemory rdpFD, ByVal pDescriptor, Len(rdpFD)
            ' 读取文件名（Unicode格式）
            fileName = String$(rdpFD.cFileName, vbNullChar)
            CopyMemory ByVal StrPtr(fileName), ByVal (pDescriptor + Len(rdpFD)), rdpFD.cFileName * 2
            fileName = Left$(fileName, InStr(fileName, vbNullChar) - 1)
            
            ' 获取文件内容
            hMemContents = GetClipboardData(fmtContents)
            If hMemContents <> 0 Then
                pContents = GlobalLock(hMemContents)
                If pContents <> 0 Then
                    ' 获取内容大小
                    contentSize = GlobalSize(hMemContents)
                    ReDim fileContent(0 To contentSize - 1)
                    CopyMemory fileContent(0), ByVal pContents, contentSize
                    ' 将文件名和内容添加到集合
                    colFiles.Add Array(fileName, fileContent)
                    GlobalUnlock hMemContents
                End If
            End If
            
            GlobalUnlock hMemDescriptor
        End If
    End If
    
    CloseClipboard
    Set GetRDPClipboardFiles = colFiles
End Function

3. 使用示例 #

调用函数获取文件并保存到临时目录：

Sub TestRDPClipboard()
    Dim colFiles As Collection
    Dim item As Variant
    Dim savePath As String
    
    Set colFiles = GetRDPClipboardFiles()
    
    If colFiles.Count = 0 Then
        MsgBox "剪贴板中无来自本地的文件"
        Exit Sub
    End If
    
    savePath = Environ("TEMP") & "\"
    For Each item In colFiles
        Open savePath & item(0) For Binary Access Write As #1
            Put #1, , item(1)
        Close #1
        MsgBox "文件已保存：" & savePath & item(0)
    Next
End Sub

补充说明 #

• 该方法仅适用于RDP会话中从本地复制到远程的文件，本地环境下仍可使用原CF_HDROP的读取逻辑。
• 若剪贴板中有多个文件，需扩展代码循环解析描述符（上述示例仅处理单个文件）。

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