クリップボードからファイル名を取得


エクスプローラなどでコピーしてクリップボードに入っているファイルの名前を取得する。


Option Explicit
 
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function CountClipboardFormats Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function PlayEnhMetaFile Lib "gdi32" (ByVal hdc As Long, ByVal hEMf As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Enum CF
    CF_BITMAP = 2
    CF_DIB = 8
    CF_DIBV5 = 17
    CF_DIF = 5
    CF_DSPBITMAP = &H82
    CF_DSPENHMETAFILE = &H8E
    CF_DSPMETAFILEPICT = &H83
    CF_DSPTEXT = &H81
    CF_ENHMETAFILE = 14
    CF_GDIOBJFIRST = &H300
    CF_GDIOBJLAST = &H3FF
    CF_HDROP = 15
    CF_LOCALE = 16
    CF_METAFILEPICT = 3
    CF_OEMTEXT = 7
    CF_OWNERDISPLAY = &H80
    CF_PALETTE = 9
    CF_PENDATA = 10
    CF_PRIVATEFIRST = &H200
    CF_PRIVATELAST = &H2FF
    CF_RIFF = 11
    CF_SYLK = 4
    CF_TEXT = 1
    CF_WAVE = 12
    CF_TIFF = 6
    CF_UNICODETEXT = 13
End Enum
 
Public Function GetFileNamesFromClipBoard(hWnd As Long) As String
    Dim I As Long
    Dim J As Long
    Dim hDrop As Long
    Dim nFileCount As Long
    Dim sFileName As String * 255
    Dim sTemp As String
    Dim nTmpLng As Long
    
    Dim col As Collection
    
    On Error GoTo ErrorHandle
    
    Set col = New Collection
    
    Call OpenClipboard(hWnd)
    
    hDrop = GetClipboardData(CF_HDROP)
    
    If hDrop <> 0 Then
        nFileCount = DragQueryFile(hDrop, &HFFFFFFFF, sFileName, Len(sFileName))
        For I = 0 To nFileCount - 1
            nTmpLng = DragQueryFile(hDrop, I, sFileName, Len(sFileName))
            sTemp = Left$(sFileName, nTmpLng)
        
            For J = 1 To col.Count
                If col(J) > sTemp Then
                    Call col.Add(sTemp, sTemp, J)
                    J = -1
                    Exit For
                End If
            Next
            If J <> -1 Then
                Call col.Add(sTemp, sTemp)
            End If
        Next I
    End If

    Call CloseClipboard
    
    GetFileNamesFromClipBoard = ""
    For I = 1 To col.Count
        GetFileNamesFromClipBoard = GetFileNamesFromClipBoard & vbCrLf & col(I)
    Next
    If GetFileNamesFromClipBoard <> "" Then
        GetFileNamesFromClipBoard = Mid$(GetFileNamesFromClipBoard, 3)
    End If
    
    Exit Function
    
ErrorHandle:
    Debug.Print "Error : " & Err.Number & " " & Err.Description
    Resume Next
End Function