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

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:
Fails to copy multiple files, currently I can only copy one file
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

Your For loop was in the wrong place. This is why you were not able to loop through every file and copy it.
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