循环文件夹,使用VBA重命名符合特定条件的文件？

Question

我是VBA的新手(并且只接受过一些java培训),但是在这里的其他帖子的帮助下组装了这段代码并且已经碰壁了.

我正在尝试编写循环遍历文件夹中每个文件的代码,测试每个文件是否符合某些条件.如果满足条件,则应编辑文件名,覆盖(或删除先前)任何具有相同名称的现有文件.然后,应将这些新重命名的文件的副本复制到其他文件夹.我相信我非常接近,但是我的代码在运行时拒绝循环访问所有文件和/或崩溃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

如果它有用,文件名将以ABC_mm_dd_hh_Page _#.jpg开头,目标是将它们剪切为ABCPage#.jpg

非常感谢!

Answer 1

我认为在开始处理它们之前首先收集数组或集合中的所有文件名是一个好主意，特别是如果您要重命名它们。如果不这样做，则不能保证您不会混淆 Dir()，导致它跳过文件或处理“相同”文件两次。另外，在 VBA 中，无需转义字符串中的反斜杠。

这是使用集合的示例：

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