将用户select的多个文件（通过filedialog）复制到新创build的文件夹

任何人都可以请查看下面的代码，并告诉我我哪里错了？

基本上我试图实现，用户在列A中input名称，然后将点击上传button（同一行，列F），Excel将创build一个文件夹使用A列名称，通过filedialog窗口用户将select多个文件，应该被复制到新创build的文件夹，最后，excel还会额外创build文件夹的path（保存在D列中）并标记date（E列）。

目前的问题：

1. 无法复制多个文件，目前我只能复制一个文件
2. 文件被复制到新创build的文件夹的父文件夹，基本上无法复制到新创build的文件夹本身。

我的代码：

 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. 你的For循环在错误的地方。 这就是为什么你无法遍历每个文件并复制它。

2. 你有这个问题，因为你使用了objFSO.CopyFile myfile, Path而不是新build的文件夹名。 我改变了这部分： objFSO.CopyFile myfile, Path & Foldername & "\" 。 请注意， Path & Foldername是不够的，因为你需要\最后。

工作代码：

 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