フォルダ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のスキルは非常に錆びない限り、あなたはこれは、列Aは、4294819などのエントリを持ち、列Bの対応するエントリが何かであることをことを前提としてい

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 

を使用することができるはずですINV 4294819.pdfのように。