重命名文件夹vba中的文件

时间:2017-11-02 19:37:52

标签: excel vba excel-vba

我有代码从列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栏中所述)。

由于

1 个答案:

答案 0 :(得分:2)

除非我的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