Este ejemplo permite recuperar la lista de archivos copiados en el Clipboard.
En caso de usar en un Control ActiveX cambiar Me.Hwnd por UserControl.Hwnd.
Código completo:
Option Explicit
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 DragQueryPoint Lib "shell32.dll" (ByVal hDrop As Long, lpPoint As POINTAPI) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) 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 Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Const GHND = &H42
Private Const CF_HDROP = &HF
Private Const GET_DROP_COUNT = &HFFFFFFFF
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type DROPFILES
pFiles As Long
pt As POINTAPI
fNC As Long
fWide As Long
End Type
Dim iCounter As Integer 'counter
Dim DF As DROPFILES
Dim strFiles As String 'keeps the paths of files we want to copy
'to the clipboard
Dim hGlobal As Long 'keeps the location from the files we want to copy
'the clipboard
Dim lpGlobal As Long 'is the globallocked hGlobal
Dim hDrop As Long 'keeps the info from the clipboard
Dim lFiles As Long 'keeps the amount of files on the clipboard
Dim strFile As String 'keeps the path of the file
Private Sub cmdCopy_Click()
If OpenClipboard(Me.Hwnd) = 0 Then 'clipboard is still open
If MsgBox("Clipboard is already opened" & vbCrLf & "close?", vbYesNo + vbQuestion, Caption) = vbYes Then
'lets close the clipboard
CloseClipboard
End If
Exit Sub 'quit
End If
EmptyClipboard 'lets clear the clipboard
For iCounter = 0 To filelist.ListCount - 1
If filelist.Selected(iCounter) = True Then
strFiles = strFiles & FixPath(filelist.Path) & filelist.List(iCounter) & vbNullChar
End If
Next
'all selected items are now put in strFiles
hGlobal = GlobalAlloc(GHND, Len(DF) + Len(strFiles)) 'put all files to a exclusive number
If hGlobal Then 'if the globalalloc worked
lpGlobal = GlobalLock(hGlobal) 'lock the hGlobal
DF.pFiles = Len(DF) 'set the size of the files
Call CopyMem(ByVal lpGlobal, DF, Len(DF)) 'copy df to the lpglobal
Call CopyMem(ByVal (lpGlobal + Len(DF)), ByVal strFiles, Len(strFiles)) 'copy strfiles to lpglobal
Call GlobalUnlock(hGlobal) 'unlock hglobal again
SetClipboardData CF_HDROP, hGlobal 'put files to the clipboard
End If
CloseClipboard
End Sub
Private Sub cmdPaste_Click()
'first lets check if there are files on the clipboard
If IsClipboardFormatAvailable(CF_HDROP) = 0 Then Exit Sub
'exit sub if there aren't
If OpenClipboard(Me.Hwnd) = 0 Then 'clipboard is still open
If MsgBox("Clipboard is already opened" & vbCrLf & "close?", vbYesNo + vbQuestion, Caption) = vbYes Then
'lets close the clipboard
CloseClipboard
End If
Exit Sub 'quit
End If
hDrop = GetClipboardData(CF_HDROP) 'get the data from the clipboard
lFiles = DragQueryFile(hDrop, -1&, "", 0) 'count amount of files
strFile = Space(260) 'create new string
For iCounter = 0 To lFiles - 1 'for each file on the clipboard
Call DragQueryFile(hDrop, iCounter, strFile, Len(strFile))
'get every specific file
ListPastedFiles.AddItem strFile
Debug.Print strFile
'add them to the listpastedfiles
Next
CloseClipboard
End Sub
Public Function FixPath(strPath As String) As String
If Right(strPath, 1) <> "\" Then
FixPath = strPath & "\"
Else
FixPath = strPath
End If
'always put an "\" behind a path
End Function
Private Sub Form_Load()
filelist.Path = "c:\"
End Sub
Hola me podr{as enviar un ejemplo en Access por favor
Esto es lo que uso: https://alexborras.com/mis-funciones-en-vba-access/#mdlClipBoardbas