Copying multiple files selected by user (via filedialog) to newly created folder

Question

Can anyone please review code below and tell me where am I going wrong?

Basically what I am trying to achieve, user inputs name in the Column A, then will click upload button (same row, column F), excel would create a folder using name from Column A, via filedialog window user will select multiple files which should be copied to newly created folder, finally excel would also additionally create path to the folder (saved in column D) and stamp the date (column E).

Current problems:

1. Fails to copy multiple files, currently I can only copy one file
2. File is copied to parent folder of newly created folders, basically fails to copy to newly created folder itself.

My code:

Sub Button1_Click()

Dim objFSO As Object
Dim objFile As Object
Dim openDialog As FileDialog
Dim Foldername As String
Dim Path As String
Dim Newpath As String
Dim i As Integer
Dim myfile As String
Dim myfilePath As String

Foldername = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -5).Value
Path = "C:\Test\"

Set openDialog = Application.FileDialog(msoFileDialogFilePicker)
openDialog.AllowMultiSelect = True

Set objFSO = CreateObject("Scripting.FileSystemObject")

For i = 1 To openDialog.SelectedItems.Count
    myfile = openDialog.SelectedItems.Item(i)
Next

If openDialog.Show = -1 Then

    If Dir(Path & Foldername, vbDirectory) = "" Then
        MkDir Path & Foldername
    End If

    objFSO.CopyFile myfile, Path

    ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -2).Hyperlinks.Add ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -2), Address:=Path & Foldername, TextToDisplay:="Open Folder"
    ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -1).Value = Format(Now, "MM/dd/yyyy")

    MsgBox "Files were successfully copied"

End If

End Sub

Answer 1

1. Your For loop was in the wrong place. This is why you were not able to loop through every file and copy it.

2. You have this problem, because you used objFSO.CopyFile myfile, Path instead of the newly created folder name. I changed that part with this: objFSO.CopyFile myfile, Path & Foldername & "\" . Note that Path & Foldername is not enough, as you need to have \ at the end.

The working code:

Sub Button1_Click()

Dim objFSO As Object
Dim objFile As Object
Dim openDialog As FileDialog
Dim Foldername As String
Dim Path As String
Dim Newpath As String
Dim i As Integer
Dim myfile As String
Dim myfilePath As String

Foldername = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -5).Value
Path = "C:\Test\"

Set openDialog = Application.FileDialog(msoFileDialogFilePicker)
openDialog.AllowMultiSelect = True

Set objFSO = CreateObject("Scripting.FileSystemObject")

If openDialog.Show = -1 Then

    If Dir(Path & Foldername, vbDirectory) = "" Then
        MkDir Path & Foldername
    End If

    For i = 1 To openDialog.SelectedItems.Count
        myfile = openDialog.SelectedItems.Item(i)
        objFSO.CopyFile myfile, Path & Foldername & "\"
    Next

    ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -2).Hyperlinks.Add ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -2), Address:=Path & Foldername, TextToDisplay:="Open Folder"
    ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -1).Value = Format(Now, "MM/dd/yyyy")

    MsgBox "Files were successfully copied"

End If

Set objFSO = Nothing
Set openDialog = Nothing

End Sub