VBA Rename File Names

unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
160
Hi Team,

I was looking for some codes in bulk renaming of filenames and found below a helpful one (see current codes). I have a separate macro that can generate the file names (refer to B14). However, for me to change the filename, I do it manually. Example: Replace "." with "_Math_0619" and look for the equivalent name for the account code.


x OldFileName (Cell B14)IIIIIINew NameAlgebra0619
0001.xlsxBen_Math_0619.xlsx
0002.txt
0003.xlsx
0004.doc

<tbody>
</tbody>

Current Codes:

Sub RenameFiles()


Dim MyPath As String


ActiveSheet.Unprotect
Application.ScreenUpdating = False
Range("Filelist").Offset(1, 0).Select
RowCounter = 0
Unchanged = 0
If ActiveCell.Value = "" Then
MsgBox "No files detected", vbInformation, "Rename files"
Exit Sub
End If
MyPath = Range("Path").Value
If MyPath = "" Then
Application.ScreenUpdating = True
MsgBox "No Path specified", vbInformation, "Rename files"
Exit Sub
End If
If Right(MyPath, 1) <> "" Then MyPath = MyPath & ""
On Error GoTo BadFile
Do
If ActiveCell.Offset(RowCounter, 0).Interior.ColorIndex <> RenamedColour Then
NextFile = MyPath & ActiveCell.Offset(RowCounter, 0)
ChangeTo = MyPath & ActiveCell.Offset(RowCounter, 4)
RowCounter = RowCounter + 1
If NextFile = ChangeTo Then
Range("B" & RowCounter + Range("Filelist").Row & ":F" & RowCounter + Range("Filelist").Row).Interior.ColorIndex = UnchangedColour
Range("E" & RowCounter + Range("Filelist").Row).Value = "U"
Unchanged = Unchanged + 1
Else
Name NextFile As ChangeTo
Range("B" & RowCounter + Range("Filelist").Row & ":F" & RowCounter + Range("Filelist").Row).Interior.ColorIndex = RenamedColour
Range("E" & RowCounter + Range("Filelist").Row).Value = "R"
End If
Else
RowCounter = RowCounter + 1
End If
Loop Until ActiveCell.Offset(RowCounter, 0).Value = ""
Application.ScreenUpdating = True
MsgBox RowCounter - Unchanged & " files renamed" & Chr(13) & Unchanged & " files unchanged", vbInformation, "Rename files"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, AllowFormattingCells:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True
Exit Sub
BadFile:
Range("B" & RowCounter + Range("Filelist").Row & ":F" & RowCounter + Range("Filelist").Row).Interior.ColorIndex = ProblemColour
Range("E" & RowCounter + Range("Filelist").Row).Value = "P"
Range("Filelist").Offset(RowCounter, 0).Select
Application.ScreenUpdating = True
MsgBox "Problem with file..." & Chr(13) & Chr(13) & NextFile & Chr(13) & Chr(13) & "Error=" & Err.Description, vbCritical, "Rename files"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, AllowFormattingCells:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True
End Sub


==== ===========

Can you help me tweak the codes about to get below results (New Name Final)?

=================

RESULTS:

Main (Sheet 1)

Headers: Row 13

xOldNameIIIIIINew Name(Final)(Insert Subject Here) Example: Algebra(Insert Date) Example: 0619
0001.xlsxBen_Math_0619.xlsx
0002.txtSean_Math_0619.txt
0003.xlsxMay_Math_0619.xlsx
0004.docBeth_Math_0619.doc

<tbody>
</tbody>

Reference (Sheet 2)

Headers: Row 1

Name (Old) Name (ChangeTo)SubjectSubject (ChangeTo)
0001BenMathMath
0002SeanAlgebraMath
0003MayTrigonometryMath
0004BethPhysicsScience

<tbody>
</tbody>

Note:

1.) I need to lookup for the account number (Old Name) to second tab to get the equivalent name
3.) I need to lookup up for the subject to get the equivalent specific subject
4.) Add the date stated in H13


Any help will be much appreciated. :)
 

Forum statistics

Threads
1,082,346
Messages
5,364,823
Members
400,814
Latest member
gangstar67

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top