Bulk modifying file names

[e119687]

I have a folder structure with several hundred files. Each file contains specific measurement data for a particular (unique) serial number of a widget.

Each file contains the serial number information in a precise (repeating across all files) location. (Cell B4)

I need the file names to include the serial number. Is there a way to perform a mass update to each file name in the folder to extract the serial number from a file and then append that info to the file name?

I have include 5 sample files and a MS Word document to describe the problem a little more.

 

[Hui]

E

Try the following code

Sub RenameFiles()

Dim xDir As String
Dim xFile As String
Dim xRow As Long
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
If .Show = -1 Then
    xDir = .SelectedItems(1)
    xFile = Dir(xDir & Application.PathSeparator & "*")
    Do Until xFile = ""
        xRow = 0
        On Error Resume Next
       
       
        Workbooks.OpenText Filename:=xDir & Application.PathSeparator & xFile, Origin:=xlWindows, StartRow:=1, _
            DataType:=xlDelimited, TextQualifier:=xlTextQualifierDoubleQuote, ConsecutiveDelimiter:=False, _
            Tab:=True, Semicolon:=True, Comma:=False, Space:=False, Other:=False, OtherChar:=False, _
            FieldInfo:=Array(1, 1), DecimalSeparator:=",", ThousandsSeparator:="."
        openworkbook = ActiveWorkbook.Name

        'copy data
        Windows(openworkbook).Activate
        SerialNumber = Range("B4").Value2
                   
        Windows(openworkbook).Close
                   
        'Rename file
        fcounter = fcounter + 1
       
        'Uncomment this to save in a differenmt directory
        'Name xDir & Application.PathSeparator & xFile As _
        '    xDir & Application.PathSeparator & "Renamed Files" & Application.PathSeparator & Left(xFile, Len(xFile) - 4) & "_" & SerialNumber & Right(xFile, 4)
                 
        Name xDir & Application.PathSeparator & xFile As _
            xDir & Application.PathSeparator & Left(xFile, Len(xFile) - 4) & "_" & SerialNumber & Right(xFile, 4)
        'Debug.Print fcounter, xFile
       
        xFile = Dir
    Loop
End If
End With

Message = CStr(fcounter) & " Files processed"
Title = "Job complete"
a = MsgBox(Message, vbOKOnly, Title)

End Sub

 

[e119687]

Hui, I think "Excel Ninja" my just be an understatement. This worked flawlessly and saved me countless hours of manual work.

Thanks so much for your knowledge and willingness to help me out.