Copy a file from a specific directory and make available in clipboard

wtom0412

Board Regular
Joined
Jan 3, 2015
Messages
180
Office Version
  1. 365
Platform
  1. Windows
Good Morning All,

I have searched Google long and hard for an answer to this question to no avail!!

I need to copy a CSV file from a specific directory, and make it available to the clipbaord, so I can paste it later using ctrl + v.

I have developed a Macro that manipulates an XLSM file then saves it as a CSV into a specific directory.

The user will then manually paste the CSV (link?) into a field in an external program that will allow the CSV to be uploaded to the program.

I have defined the file name and the file location already in the macro...
strFilename = The name of the CSV to copy
strDefpath = The name of the Directory where the CSV is saved

I hope that makes sense and one of you gurus can help me?

Cheers, WT
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Someone asked the same question on this forum.

Here's the code from the post. If you look in the 'Main' sub you will see where you need to paste in your file path.

Code:
Option Explicit


' Required data structures
Private Type POINTAPI
x As Long
y As Long
End Type


' Clipboard Manager Functions
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


' Other required Win32 APIs
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)


' Predefined Clipboard Formats
Private Const CF_TEXT = 1
Private Const CF_BITMAP = 2
Private Const CF_METAFILEPICT = 3
Private Const CF_SYLK = 4
Private Const CF_DIF = 5
Private Const CF_TIFF = 6
Private Const CF_OEMTEXT = 7
Private Const CF_DIB = 8
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_RIFF = 11
Private Const CF_WAVE = 12
Private Const CF_UNICODETEXT = 13
Private Const CF_ENHMETAFILE = 14
Private Const CF_HDROP = 15
Private Const CF_LOCALE = 16
Private Const CF_MAX = 17


' New shell-oriented clipboard formats
Private Const CFSTR_SHELLIDLIST As String = "Shell IDList Array"
Private Const CFSTR_SHELLIDLISTOFFSET As String = "Shell Object Offsets"
Private Const CFSTR_NETRESOURCES As String = "Net Resource"
Private Const CFSTR_FILEDESCRIPTOR As String = "FileGroupDescriptor"
Private Const CFSTR_FILECONTENTS As String = "FileContents"
Private Const CFSTR_FILENAME As String = "FileName"
Private Const CFSTR_PRINTERGROUP As String = "PrinterFriendlyName"
Private Const CFSTR_FILENAMEMAP As String = "FileNameMap"


' Global Memory Flags
Private Const GMEM_FIXED = &H0
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_NOCOMPACT = &H10
Private Const GMEM_NODISCARD = &H20
Private Const GMEM_ZEROINIT = &H40
Private Const GMEM_MODIFY = &H80
Private Const GMEM_DISCARDABLE = &H100
Private Const GMEM_NOT_BANKED = &H1000
Private Const GMEM_SHARE = &H2000
Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_NOTIFY = &H4000
Private Const GMEM_LOWER = GMEM_NOT_BANKED
Private Const GMEM_VALID_FLAGS = &H7F72
Private Const GMEM_INVALID_HANDLE = &H8000
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)


Private Type DROPFILES
pFiles As Long
pt As POINTAPI
fNC As Long
fWide As Long
End Type




Public Function ClipboardCopyFiles(Files() As String) As Boolean


Dim data As String
Dim df As DROPFILES
Dim hGlobal As Long
Dim lpGlobal As Long
Dim i As Long


' Open and clear existing crud off clipboard.
If OpenClipboard(0&) Then
Call EmptyClipboard


' Build double-null terminated list of files.
For i = LBound(Files) To UBound(Files)
data = data & Files(i) & vbNullChar
Next
data = data & vbNullChar


' Allocate and get pointer to global memory,
' then copy file list to it.
hGlobal = GlobalAlloc(GHND, Len(df) + Len(data))
If hGlobal Then
lpGlobal = GlobalLock(hGlobal)


' Build DROPFILES structure in global memory.
df.pFiles = Len(df)
Call CopyMem(ByVal lpGlobal, df, Len(df))
Call CopyMem(ByVal (lpGlobal + Len(df)), ByVal data, Len(data))
Call GlobalUnlock(hGlobal)


' Copy data to clipboard, and return success.
If SetClipboardData(CF_HDROP, hGlobal) Then
ClipboardCopyFiles = True
End If
End If


' Clean up
Call CloseClipboard
End If


End Function


Public Function ClipboardPasteFiles(Files() As String) As Long


Dim hDrop As Long
Dim nFiles As Long
Dim i As Long
Dim desc As String
Dim filename As String
Dim pt As POINTAPI
Const MAX_PATH As Long = 260


' Insure desired format is there, and open clipboard.
If IsClipboardFormatAvailable(CF_HDROP) Then
If OpenClipboard(0&) Then


' Get handle to Dropped Filelist data, and number of files.
hDrop = GetClipboardData(CF_HDROP)
nFiles = DragQueryFile(hDrop, -1&, "", 0)


' Allocate space for return and working variables.
ReDim Files(0 To nFiles - 1) As String
filename = Space(MAX_PATH)


' Retrieve each filename in Dropped Filelist.
For i = 0 To nFiles - 1
Call DragQueryFile(hDrop, i, filename, Len(filename))
Files(i) = TrimNull(filename)
Next


' Clean up
Call CloseClipboard
End If


' Assign return value equal to number of files dropped.
ClipboardPasteFiles = nFiles
End If


End Function


Private Function TrimNull(ByVal sTmp As String) As String


Dim nNul As Long


'
' Truncate input sTmpg at first Null.
' If no Nulls, perform ordinary Trim.
'
nNul = InStr(sTmp, vbNullChar)
Select Case nNul
Case Is > 1
TrimNull = Left(sTmp, nNul - 1)
Case 1
TrimNull = ""
Case 0
TrimNull = Trim(sTmp)
End Select


Sub Main()


Dim afile(0) As String
afile(0) = "Your File Path here" 'The file actually exists
MsgBox ClipboardCopyFiles(afile)


End Sub
 
Upvote 0
Thank you Irobbo314,

I did find this, but it is way beyond my understanding, it confused me greatly.

Firstly, I am not familiar with Private Type? Is this just a bunch of parameters for the Functions to work? Also, when I paste this into a Module, the "Clipboard Manager Functions" and "Other required Win32 APIs" at the top are red. Does this mean that the Function won't work?

Secondly, I don't know how to apply this to the solution? Do I call the Function from a button or clickable text?

And, there seem to be a lot of Calls to Functions that don't seem to exist in the solution (like CopyMem, GlobalUnlock and CloseClipboard)?

I was hoping for a "simple" way to do this (I am aware that "simple" is relative to one's understanding!!)

Cheers, WT
 
Upvote 0
Are you working with a 64 bit version of Excel?
 
Upvote 0
Sounds like that is the reason why you are getting the red highlighting going on. I've adjusted the top portion the best I can. I can't test if it works or not since I'm on 32 bit. For 64 bit there's some differences in how you declare this Windows API nonsense.

Code:
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
' Clipboard Manager Functions
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long


' Other required Win32 APIs
Private Declare PtrSafe 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 PtrSafe Function DragQueryPoint Lib "shell32.dll" (ByVal hDrop As Long, lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe 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)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 


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 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)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Using this #If #End if will allow the code to work regardless of whether the user has a 32 or 64 bit version of Excel. This site breaks down this info pretty well.
 
Upvote 0
Hiya,

Thank you.

There is still some red - the first line is the last line of "Other required Win32 APIs"...

Code:
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)#Else




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 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)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Would it work just to comment out the red?
 
Upvote 0
You could try changing the variable types on that line from 'Long' to 'LongPtr'.

Also, it looks like you can just comment that line out. Seems to work without it.
 
Upvote 0
Thanks Irobbo,

I'll try that.

Can you offer me any advice on how to use the Functions, and how I Call them?

Cheers, WT
 
Upvote 0
Hello,

this is very usefull , but now with office 365 , it's take 2 minute to execute .
any help will be appreciate.
Cheers
 
Upvote 0

Forum statistics

Threads
1,213,530
Messages
6,114,163
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top