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
|