vba - 重命名文件夹 vba 中的文件

Question

我有代码从 A 列中查找文件名，并将文件重命名为源文件夹中 B 列中的文件，然后复制到新文件夹。

代码如下。

Sub Rename_Files()
    Dim SourcePath, DestPath, Fname, NewFName
    SourcePath = "C:\Invoices\"
    DestPath = "C:\Invoices\Renamed\"
    For i = 1 To 100
        Fname = Range("A" & i).Value
        NewFName = Range("B" & i).Value
        If Not Dir(SourcePath & Fname, vbDirectory) = vbNullString Then
            FileCopy SourcePath & Fname, DestPath & NewFName
        Else
            MsgBox (Fname & " Not Exists in Folder")
        End If
    Next i
End Sub

问题是源目录中的文件名很长，如 'INVOICEDUMP_OFND_4294819_ABC Corp.pdf' 以及数百个这样的文件名。

我想找到名称中包含 4294819(来自 A 列)的文件，然后仅将名称替换为 'INV 4294819.pdf'(如 B 列中所述)。

谢谢

Answer 1

除非我的DOS技能非常生疏，否则你应该会用

Sub Rename_Files()
    Dim SourcePath As String, DestPath As String, Fname As String, NewFName As String
    Dim i As Long
    SourcePath = "C:\Invoices\"
    DestPath = "C:\Invoices\Renamed\"
    For i = 1 To 100
        If Not IsEmpty(Range("A" & i).Value) Then
            NewFName = Range("B" & i).Value
            'Search for the first file containing the string in column A
            Fname = Dir(SourcePath & "*" & Range("A" & i).Value & "*")
            If Fname <> vbNullString Then
                FileCopy SourcePath & Fname, DestPath & NewFName
            Else
                MsgBox Range("A" & i).Value & " Not Exists in Folder"
            End If
        End If
    Next i
End Sub

假设 A 列具有诸如 4294819 之类的条目，并且 B 列中的相应条目类似于 INV 4294819.pdf。