Copy multiple files to multiple folders using FileDialog in Excel vba - excel

Question

I'm trying to build vba code to copy files from a fixed folder to another folder.
My problem is that I want to specify where to copy the files using "Application.FileDialog(msoFileDialogFolderPicker)" and i don't know to do it.
Any help would be appreciated.
Sub Copy_Folder()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim F As Object
Set F = Application.FileDialog(msoFileDialogFolderPicker)
FromPath = "Z:\Templates\Template 2020"
ToPath = "C:\Users\ocosmele\Desktop\New folder"
If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If
If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
FSO.CopyFolder source:=FromPath, destination:=ToPath
MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
End Sub

Answer 1

Just adjusted the first part of your code. Please read the code's comments and adjust it to fit your needs.
Option Explicit
Sub Copy_Folder()
Dim fso As Object
Dim targetFolder As Object
Dim fromPath As String
Dim intialPath As String
Dim toPath As String
' Initialize the file system object
Set fso = CreateObject("Scripting.FileSystemObject")
fromPath = "C:\Temp\Test"
intialPath = "C:\Users\ocosmele\Desktop\New folder"
' Ask user for the destination folder
Set targetFolder = Application.fileDialog(msoFileDialogFolderPicker)
' Define the target folder dialog box properties and result
With targetFolder
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = intialPath
If .Show <> -1 Then
MsgBox "You didn't select anything"
Exit Sub
End If
toPath = .SelectedItems(1)
End With
If Right(fromPath, 1) = "\" Then
fromPath = Left(fromPath, Len(fromPath) - 1)
End If
If Right(toPath, 1) = "\" Then
toPath = Left(toPath, Len(toPath) - 1)
End If
If fso.FolderExists(fromPath) = False Then
MsgBox fromPath & " doesn't exist"
Exit Sub
End If
fso.CopyFolder Source:=fromPath, Destination:=toPath
MsgBox "You can find the files and subfolders from " & fromPath & " in " & toPath
End Sub
Let me know if it works.