【发布时间】:2014-07-29 21:07:26
【问题描述】:
我正在编写一个宏,需要:
1 从特定文件夹和该文件夹的子文件夹中获取文件列表(大约 10k 行),并将其发布到 Excel 工作簿(Sheet1)中,A 列中的文件名和扩展名为“somefile.ext”,列中的完整文件路径C(例如 D:\2014\Client Name\Misc\somefile.ext)
2 过滤掉符合我要求的文件,删除不符合要求的行。
3 使用 C 列中的完整路径将列出的文件复制到新目录中,但保留子文件夹结构,以便:
D:\2014\Client Name\Misc\somefile.ext 变为 D:\2015\Client Name\Misc\somefile.ext。
路径已经存在(使用此宏创建)在新文件夹中,但文件不存在。
现在我自己已经达到了#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:\2014"
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
【问题讨论】:
-
如果您发布现有代码,提出建议会容易得多。按照您发布的描述,您似乎只需将“\2014\”替换为“\2015\”即可获得目标路径?
-
正确,我还需要实际转到原始路径的代码,从子文件夹“D:\2014\Client Name\Misc”中获取文件并将其复制到新路径 D:\2015\客户名称\杂项,然后转到列表中的另一个。我还用我到目前为止的代码更新了帖子。如您所见,我什至还没有开始编写复制代码。
-
在 VBA 中复制文件非常简单:
FileCopy "D:\2014\Client Name\Misc\somefile.ext", "D:\2015\Client Name\Misc\somefile.ext" -
这适用于这个特定路径中的一个文件(对吗?),但我有大约 3K 个文件,每个文件都位于不同的客户端名称文件夹下。只有常量是 D:\2014\...\Misc 和 D:\2015\...\Misc 。此外,所有这些路径都列在一个 excel 文件中(我使用了 Sub ListFiles())。我正在尝试了解如何使 VBA 使用此 excel 路径列表进行复制。我在想 FileSystemObject 但还不知道怎么做。
-
您可以使用现有路径遍历范围内的单元格,并为每个单元格调用
FileCopy cell.Value, Replace(cell.value,"D:\2014\", "D:\2015\")您甚至不需要 FSO:FileCopy是 VBA 中的本机调用。