Copy multiple files to multiple folders using FileDialog in Access vba - ms-access

Question

I am looking for a way to copy multiple files from a single folder and copy this grouping of files to multiple folders using FileDialog in Access vba. Below is what I have so far - the problem with this code is that I can only copy multiple files from a single folder to another single folder. Can anyone help with this:
Public Function CopyFilesToFolders()
On Error GoTo Err_Copy
Dim sourcefiles As String
Dim destination As String
Dim source As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a folder that contains the desired files to copy."
If .Show = -1 Then source = .SelectedItems(1)
If Len(source) = 0 Then Exit Function
.AllowMultiSelect = True
.Title = "Select a folder location to copy the files."
If .Show = -1 Then destination = .SelectedItems(1)
If Len(destination) = 0 Then Exit Function
End With
sourcefiles = Dir$(source & "\*.*")
Do While Len(sourcefiles) > 0
FileCopy (source & "\" & sourcefiles), (destination & "\" & sourcefiles)
sourcefiles = Dir$
Loop
Exit_Copy:
Exit Function
Err_Copy:
CopyFilesToFolders = True
MsgBox Error$
Resume Exit_Copy
MsgBox "Task Complete!"
End Function
Thank you,
Al

Answer 1

So you want the function to automatically detect all the subfolders and copy the selected files to them? You can use FileSystemObject to detect all the subfolders, then copy the files to them. See this modified function:
Public Function CopyFilesToFolders()
On Error GoTo Exit_Copy
Dim sourcefiles As String
Dim destination As String
Dim source As String
Dim FileSystem As Object
Set FileSystem = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a folder that contains the desired files to copy."
If .Show = -1 Then source = .SelectedItems(1)
If Len(source) = 0 Then Exit Function
.AllowMultiSelect = True
.Title = "Select a folder location to copy the files."
If .Show = -1 Then destination = .SelectedItems(1)
If Len(destination) = 0 Then Exit Function
End With
sourcefiles = Dir$(source & "\*.*")
Dim SubFolder
Do While Len(sourcefiles) > 0
For Each SubFolder In FileSystem.GetFolder(destination).SubFolders
FileCopy (source & "\" & sourcefiles), (SubFolder.path & "\" & sourcefiles)
Next
sourcefiles = Dir$
Loop
Exit_Copy:
Exit Function
End Function

Answer 2

Sorry, for changing the topic a bit, but I think int would be a lot easier to do this in Excel, rather than in Access. See the example below.
Sub sbCopyingAFile()
'Declare Variables
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String
'This is Your File Name which you want to Copy
sFile = "Sample.xls"
'Change to match the source folder path
sSFolder = "C:\Temp\"
'Change to match the destination folder path
sDFolder = "D:\Job\"
'Create Object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Checking If File Is Located in the Source Folder
If Not FSO.FileExists(sSFolder & sFile) Then
MsgBox "Specified File Not Found", vbInformation, "Not Found"
'Copying If the Same File is Not Located in the Destination Folder
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
FSO.CopyFile (sSFolder & sFile), sDFolder, True
MsgBox "Specified File Copied Successfully", vbInformation, "Done!"
Else
MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If
End Sub
Now, if you want to dynamically list the files in a folder, each file path in an individual cell, and then specify exactly which files to copy from one folder to another, that is definitely doable. First, try the sample code above, and give me feedback for future enhancements.