need vba code for renaming all word files with mapping logic mentioned in excel

[yallamanda.b]

Hi Team,

colud you please help I need to Rename all word files which is saved in some folder ex patch:Documents i mentions all saved word files in excel A column should Rename with B column ids in Documents path.

pfa for more information.

Thanks

 

[Thangavel]

Hi, Could you please try this code in your excel.

Sub Rename()
    Dim Source As Range
    Dim OldFile As String
    Dim NewFile As String
    Dim Row As Long
    Set Source = Cells(1, 1).CurrentRegion
    For Row = 1 To Source.Rows.Count
        OldFile = ActiveSheet.Cells(Row, 1)
        NewFile = ActiveSheet.Cells(Row, 2)
        'see if NewFile contains an extension
        If InStr(Right(NewFile, 6), ".") > 0 Then
            'if so, strip it off
            NewFile = Left(NewFile, InStrRev(NewFile, ".") - 1)
        End If
        'append extension
        NewFile = NewFile & Mid(OldFile, InStrRev(OldFile, "."))
        ' rename files
        Name OldFile As NewFile
    Next
End Sub

 

[Thangavel]

Hello,
Or try this below one.

Regards,
Thangavel D

Sub RenameFiles()
'Updateby20141124
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
        xRow = Application.Match(xFile, Range("A:A"), 0)
        If xRow > 0 Then
            Name xDir & Application.PathSeparator & xFile As _
            xDir & Application.PathSeparator & Cells(xRow, "B").Value
        End If
        xFile = Dir
    Loop
End If
End With
End Sub

 

[yallamanda.b]

HI I Tried This code when i was debugging it is asking The folder path Even when i had selected the folder name it is not renaming the word files

Thanks

 

[Thangavel]

HI I Tried This code when i was debugging it is asking The folder path Even when i had selected the folder name it is not renaming the word files

Thanks

Hello.
You need to update old & new file names with their extension. Please refer the screenshot, how to update the file names.



Here is the easy one:

Sub Rename_Files()

'Declare Variable
Dim path_dir As String
Dim file_name As String
Dim row_cntr As Long
Dim column_old_file As String
Dim column_new_file As String

'Assign values to string variable for old and new file name
column_old_file = "A:A"
column_new_file = "B:B"

'code to select input file folder and rename filename using Do Until loop
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
If .Show = -1 Then
    path_dir = .SelectedItems(1)
    file_name = Dir(path_dir & Application.PathSeparator & "*")
    Do Until file_name = ""
        row_cntr = 0
        On Error Resume Next
        row_cntr = Application.Match(file_name, Range(column_old_file), 0)
        If row_cntr > 0 Then
            Name path_dir & Application.PathSeparator & file_name As _
            path_dir & Application.PathSeparator & Cells(row_cntr, "B:B").Value
        End If
        file_name = Dir
    Loop
End If
End With

MsgBox "All files renamed successfully", vbInformation

End Sub

 

[yallamanda.b]

Hi I have past the code in excel and compliled.
it is asking to select folder name after run the code the files are not modified.

Requirment is:

Example
In Folder D:\orders we have word files ex 10 with extention firstcopy_0001.docx firstcopy_0002.docx which is metioned in A column in Excel file i need to Rename as order ids whichis mentioned in B column.

Thanks

 

[Thangavel]

Hi I have past the code in excel and compliled.
it is asking to select folder name after run the code the files are not modified.

Requirment is:

Example
In Folder D:\orders we have word files ex 10 with extention firstcopy_0001.docx firstcopy_0002.docx which is metioned in A column in Excel file i need to Rename as order ids whichis mentioned in B column.

Thanks

Hi,
For me & in my system its working. Could you please share the screenshot of the folder?



Regards,
Thangavel

 

[Kenneth Hobson]

Sub rnFiles()
  'Tools > Settings > Microsoft Scripting Runtime
  'Dim fso As New FileSystemObject
  Dim fso As Object
  Dim p$, f1$, f2$, r As Range, c As Range
 
  'Change Path to suit
  p = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  If Not fso.FolderExists(p) Then
    MsgBox p & " does not exit.", vbCritical, "Maro Ending"
    Exit Sub
  End If
 
  Set r = Range("A2", Cells(Rows.Count, "A").End(xlUp))
  For Each c In r
    With fso
      f1 = p & c.Value: f2 = p & c.Offset(, 1).Value
      If .FileExists(f1) And Not .FileExists(f2) Then
        .MoveFile f1, f2
        Range(c, c.Offset(, 1)).Interior.Color = vbGreen
        Else:  Range(c, c.Offset(, 1)).Interior.Color = vbRed
      End If
    End With
  Next c
End Sub