Visual Basic. Copiar y Pegar Archivos desde ClipBoard
1948
post-template-default,single,single-post,postid-1948,single-format-standard,ajax_fade,page_not_loaded,,vertical_menu_enabled,side_area_uncovered_from_content,qode-theme-ver-11.0,qode-theme-bridge,wpb-js-composer js-comp-ver-5.0.1,vc_responsive

Visual Basic. Copiar y Pegar Archivos desde ClipBoard

Visual Basic. Copiar y Pegar Archivos desde ClipBoard

Este ejemplo permite recuperar la lista de archivos copiados en el Clipboard.

Ejemplo Copy and Paste

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

1 Star2 Stars3 Stars4 Stars5 Stars (No Ratings Yet)
Cargando…
Tags:
No Comments

Deja un comentario

Uso de cookies

Este sitio web utiliza cookies para que usted tenga la mejor experiencia de usuario. Si continúa navegando está dando su consentimiento para la aceptación de las mencionadas cookies y la aceptación de nuestra política de cookies, pinche el enlace para mayor información.plugin cookies

ACEPTAR
Aviso de cookies
Ver botones
Ocultar botones