エクスプローラのファイルコピー情報を取り出す

エクスプローラのコピー情報を取り出す処理をもともと作成していたが、ANSI版を呼んでいて、UNICODE対応していなかったことと、微妙なバグ、Excel 2007を対象外としたことでとてもシンプルな記述にした。２ファイル以上の場合、CRLFで区切って返却。

Excelバージョン:Excel 2010 以上
32bit/64bit版 UNICODE対応

’Excel 2010 以降 32/64bit 対応
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function DragQueryFileW Lib "shell32.dll" (ByVal hDrop As LongPtr, ByVal UINT As Long, ByVal lpszFile As LongPtr, ByVal ch As Long) As Long
Private Const CF_HDROP As Long = 15
'--------------------------------------------------------------
'　クリップボードからファイル名を取得
'--------------------------------------------------------------
Public Function GetCopyClipText() As String

    Dim hData As LongPtr
    Dim files As Long
    Dim i As Long
    Dim strFilePath As String
    Dim ret As String
    
    If OpenClipboard(0) <> 0 Then
   
        hData = GetClipboardData(CF_HDROP)
        
        If Not IsNull(hData) Then
            
            'ファイルの数を取得
            files = DragQueryFileW(hData, -1, 0, 0)
            For i = 0 To files - 1 Step 1
                
                'サイズを取得
                Dim lngSize As Long
                lngSize = DragQueryFileW(hData, i, 0, 0)
                
                'DragQueryFileWの返却するサイズは終端を含まない
                strFilePath = String$(lngSize + 1, vbNullChar)
                
                lngSize = DragQueryFileW(hData, i, StrPtr(strFilePath), Len(strFilePath))
                
                If i = 0 Then
                    ret = Left$(strFilePath, lngSize)
                Else
                    ret = ret & vbCrLf & Left$(strFilePath, lngSize)
                End If
            Next
        End If
        Call CloseClipboard
    
    End If
    
    GetCopyClipText = ret
    
End Function