循环遍历文件夹，使用 VBA 重命名满足特定条件的文件？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/26824225/
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
Loop through folder, renaming files that meet specific criteria using VBA?
提问by Joe K
I am new to VBA (and have only a bit of training in java), but assembled this bit of code with the help of other posts here and have hit a wall.
我是 VBA 的新手（并且只接受了一点 Java 培训），但是在这里的其他帖子的帮助下组装了这段代码并且遇到了障碍。
I am trying to write code that will cycle through each file in a folder, testing if each file meets certain criteria. If criteria are met, the file names should be edited, overwriting (or deleting prior) any existing files with the same name. Copies of these newly renamed files should then be copied to a different folder. I believe I'm very close, but my code refuses to cycle through all files and/or crashes Excel when it is run. Help please? :-)
我正在尝试编写代码，循环遍历文件夹中的每个文件，测试每个文件是否满足特定条件。如果满足条件，则应编辑文件名，覆盖（或删除之前）任何具有相同名称的现有文件。然后应将这些新重命名的文件的副本复制到不同的文件夹中。我相信我非常接近，但是我的代码在运行时拒绝遍历所有文件和/或使 Excel 崩溃。请帮忙？:-)
Sub RenameImages()
Const FILEPATH As String = _
"C:\CurrentPath"
Const NEWPATH As String = _
"C:\AditionalPath"
Dim strfile As String
Dim freplace As String
Dim fprefix As String
Dim fsuffix As String
Dim propfname As String
Dim FileExistsbol As Boolean
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
strfile = Dir(FILEPATH)
Do While (strfile <> "")
Debug.Print strfile
If Mid$(strfile, 4, 1) = "_" Then
fprefix = Left$(strfile, 3)
fsuffix = Right$(strfile, 5)
freplace = "Page"
propfname = FILEPATH & fprefix & freplace & fsuffix
FileExistsbol = FileExists(propfname)
If FileExistsbol Then
Kill propfname
End If
Name FILEPATH & strfile As propfname
'fso.CopyFile(FILEPATH & propfname, NEWPATH & propfname, True)
End If
strfile = Dir(FILEPATH)
Loop
End Sub
If it's helpful, the file names start as ABC_mm_dd_hh_Page_#.jpg and the goal is to cut them down to ABCPage#.jpg
如果有帮助，文件名以 ABC_mm_dd_hh_Page_#.jpg 开头，目标是将它们缩减为 ABCPage#.jpg
Thanks SO much!
非常感谢！
采纳答案by Tim Williams
I think it's a good idea to first collect all of the filenames in an array or collection before starting to process them, particularly if you're going to be renaming them. If you don't there's no guarantee you won't confuse Dir(), leading it to skip files or process the "same" file twice. Also in VBA there's no need to escape backslashes in strings.
我认为在开始处理它们之前首先收集数组或集合中的所有文件名是个好主意，特别是如果您要重命名它们。如果不这样做，则无法保证您不会混淆 Dir()，从而导致它跳过文件或两次处理“相同”文件。同样在 VBA 中，不需要转义字符串中的反斜杠。
Here's an example using a collection:
这是使用集合的示例：
Sub Tester()
Dim fls, f
Set fls = GetFiles("D:\Analysis\", "*.xls*")
For Each f In fls
Debug.Print f
Next f
End Sub
Function GetFiles(path As String, Optional pattern As String = "") As Collection
Dim rv As New Collection, f
If Right(path, 1) <> "\" Then path = path & "\"
f = Dir(path & pattern)
Do While Len(f) > 0
rv.Add path & f
f = Dir() 'no parameter
Loop
Set GetFiles = rv
End Function
回答by Ahmad
EDIT: See update below for an alternative solution.
编辑：有关替代解决方案，请参阅下面的更新。
Your code has one major problem.. The last line before the Loopend is
您的代码有一个主要问题..Loop结束前的最后一行是
...
strfile = Dir(FILEPATH) 'This will always return the same filename
Loop
...
Here is what your code should be:
这是您的代码应该是什么：
...
strfile = Dir() 'This means: get the next file in the same folder
Loop
...
The fist time you call Dir(), you should specify a path to list files, so before you entered the loop, the line:
第一次调用时Dir()，您应该指定一个列出文件的路径，因此在进入循环之前，该行：
strfile = Dir(FILEPATH)
is good. The function will return the first file that matches the criteria in that folder. Once you have finished processing the file, and you want to move to the next file, you should call Dir()without specifying a parameter to indicate that you are interested in iterating to the next file.
很好。该函数将返回与该文件夹中的条件匹配的第一个文件。一旦您完成了文件的处理，并且您想要移动到下一个文件，您应该在Dir()不指定参数的情况下调用以指示您有兴趣迭代到下一个文件。
=======
========
As an alternative solution, you can use the FileSystemObjectclass provided to VBA instead of creating an object by the operating system.
作为替代解决方案，您可以使用FileSystemObject提供给 VBA的类，而不是由操作系统创建对象。
First, add the "Microsoft Scripting Runtime" library by going to Tools->References->Microsoft Scripting Runtime
首先，通过转到 Tools->References->Microsoft Scripting Runtime 添加“Microsoft Scripting Runtime”库
In case, you did not see [Microsoft Scripting Runtime] listed, just browse to C:\windows\system32\scrrun.dlland that should do the same.
如果您没有看到列出的 [Microsoft Scripting Runtime]，只需浏览至C:\windows\system32\scrrun.dll该列表即可。
Second, change your code to utilize the referenced library as follows:
其次，更改您的代码以使用引用的库，如下所示：
The following two lines:
以下两行：
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
should be replaced by this single line:
应替换为这一行：
Dim fso As New FileSystemObject
Now run your code. If you still face an error, at least this time, the error should have more details about its origin, unlike the generic one provided by the vague object from before.
现在运行你的代码。如果您仍然遇到错误，至少这次，错误应该有更多关于其起源的详细信息，这与之前的模糊对象提供的通用错误不同。
回答by Joe K
In case anyone is wondering, here is my finished code. Thanks to Tim and Ahmad for their help!
如果有人想知道，这是我完成的代码。感谢 Tim 和 Ahmad 的帮助！
Sub RenameImages()
Const FILEPATH As String = "C:\CurrentFilepath\"
Const NEWPATH As String = "C:\NewFilepath\"
Dim strfile As String
Dim freplace As String
Dim fprefix As String
Dim fsuffix As String
Dim propfname As String
Dim fls, f
Set fls = GetFiles(FILEPATH)
For Each f In fls
Debug.Print f
strfile = Dir(f)
If Mid$(strfile, 4, 1) = "_" Then
fprefix = Left$(strfile, 3)
fsuffix = Right$(strfile, 5)
freplace = "Page"
propfname = FILEPATH & fprefix & freplace & fsuffix
FileExistsbol = FileExists(propfname)
If FileExistsbol Then
Kill propfname
End If
Name FILEPATH & strfile As propfname
'fso.CopyFile(FILEPATH & propfname, NEWPATH & propfname, True)
End If
Next f
End Sub
Function GetFiles(path As String, Optional pattern As String = "") As Collection
Dim rv As New Collection, f
If Right(path, 1) <> "\" Then path = path & "\"
f = Dir(path & pattern)
Do While Len(f) > 0
rv.Add path & f
f = Dir() 'no parameter
Loop
Set GetFiles = rv
End Function
Function FileExists(fullFileName As String) As Boolean
If fullFileName = "" Then
FileExists = False
Else
FileExists = VBA.Len(VBA.Dir(fullFileName)) > 0
End If
End Function
