VBA 使用 Excel 对象中列出的完整路径和文件名复制文件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/25025009/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA to Copy files using complete path and file names listed in Excel Object
提问by user3889304
I am writing a macro that needs to:
我正在编写一个需要执行以下操作的宏：
1 Get file list (around 10k rows) from a specific folder and subfolders of that folder and post it into an excel workbook (Sheet1) with File name and extension "somefile.ext" in column A and complete file path in column C (eg. D:\2014\Client Name\Misc\somefile.ext)
1 从特定文件夹和该文件夹的子文件夹中获取文件列表（大约 10k 行），并将其发布到 Excel 工作簿（Sheet1）中，A 列中的文件名和扩展名为“somefile.ext”，C 列中的完整文件路径（例如.D:\2014\Client Name\Misc\somefile.ext)
2 Filter out the files that meet my requirement and delete rows that do not.
2 过滤掉符合我要求的文件，删除不符合要求的行。
3 use the complete path from column C to copy those listed files into a new directory but maintaining the subfolder structure so that:
3 使用 C 列中的完整路径将这些列出的文件复制到新目录中，但保持子文件夹结构，以便：
D:\2014\Client Name\Misc\somefile.ext becomes D:\2015\Client Name\Misc\somefile.ext .
D:\2014\Client Name\Misc\somefile.ext 变为 D:\2015\Client Name\Misc\somefile.ext 。
Where the path already exists (created with this macro) in the new folder but the file does not.
新文件夹中已存在路径（使用此宏创建）但文件不存在的位置。
Now I have made it up to #3 on my own. I am stuck at copying those files, I simply lack the know-how. I am asking you guys for help.
现在我自己已经达到了#3。我一直在复制这些文件，我只是缺乏专业知识。我向你们寻求帮助。
Here is the code that works up to but not including point 3:
这是适用于但不包括第 3 点的代码：
Option Explicit
Sub ListFiles()
Dim objFSO As Scripting.FileSystemObject
Dim objTopFolder As Scripting.folder
Dim strTopFolderName As String
Range("A1").Value = "File Name"
Range("B1").Value = "File Type"
Range("C1").Value = "File Patch"
strTopFolderName = "D:14"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTopFolder = objFSO.GetFolder(strTopFolderName)
Call RecursiveFolder(objTopFolder, True)
Columns.AutoFit
End Sub
Sub RecursiveFolder(objFolder As Scripting.folder, _
IncludeSubFolders As Boolean)
Dim objFile As Scripting.file
Dim objSubFolder As Scripting.folder
Dim NextRow As Long
NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each objFile In objFolder.Files
Cells(NextRow, "A").Value = objFile.Name
Cells(NextRow, "B").Value = objFile.Type
Cells(NextRow, "C").Value = objFile.path
NextRow = NextRow + 1
Next objFile
If IncludeSubFolders Then
For Each objSubFolder In objFolder.SubFolders
Call RecursiveFolder(objSubFolder, True)
Next objSubFolder
End If
End Sub
Sub delete_rows()
Dim lastrow As Long
Dim row_index As Long
Application.ScreenUpdating = False
lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For row_index = lastrow - 1 To 1 Step -1
If InStr(Cells(row_index, "A").Value, "Processing") = 0 Then
Cells(row_index, "A").EntireRow.Delete
End If
Next
Columns.AutoFit
Application.ScreenUpdating = True
End Sub
采纳答案by dcromley
I think this will do what you want (You can remove the /K to make the command window go away).
我认为这会做你想做的（你可以删除 /K 使命令窗口消失）。
Call Shell("""cmd"" /K copy " & _
"D:14\Client Name\Misc\somefile.ext " & _
"D:15\Client Name\Misc\somefile.ext", vbNormalFocus)
EDIT: Tim's answer (as a comment) is much more straightforward. I was thinking that a "shelled" command could use wildcards, which may be useful and I don't think you can do that using FileCopy.
编辑：蒂姆的回答（作为评论）要简单得多。我在想一个“shelled”命令可以使用通配符，这可能很有用，我认为你不能使用 FileCopy 来做到这一点。
FileCopy source, destination
source: Required. String expression that specifies the name of the file to be copied. The source may include directory or folder, and drive. destination: Required. String expression that specifies the target file name. The destination may include directory or folder, and drive.
来源：必填。指定要复制的文件名称的字符串表达式。源可能包括目录或文件夹和驱动器。目的地：必填。指定目标文件名的字符串表达式。目的地可能包括目录或文件夹以及驱动器。
