Mass file renaming

[Uptickdk]

I need to change 200 .pdf files which are currently named by account number to the name of the account. I.E. 12345.pdf to Smith.pdf. All files are in one folder and the output would go into another folder or sub folder, I don't care just want to separate the numbered files from the named files.

In a spreadsheet I have all the account numbers listed in column A and the corresponding account names in column B.

I am new to VBAs/ macros so any help would be great and instructions are awesome.

Thanks
Uptickdk

[Kenneth Hobs]

Welcome to the forum!

Do the cells have the file extension PDF or is it just the base name of 12345 and Smith?

[Uptickdk]

the cells only have the base account number or the account name. No .pdf or either column

Thanks,

[Kenneth Hobs]

I thought that might be the case. Backup your files first.

I included the early binding method for the File Scripting Object in the comments but it is set up for late binding as is. This means that you will not need to add the Microsoft Scripting Runtime reference. I recommend adding the reference and using early binding when you want to work with the File Scripting Object for other projects.

Change the original and new path variable values as needed. This opens a DOS shelled window and asks to overwrite the file if needed. In the commented 2nd Case, you can choose to uncomment it to exit gracefully or Shell and create the new path.

In the Visual Basic Editor, VBE, Alt+F11, Insert a Module and paste:

[vba]Sub RenameFiles()
Dim fso As Object
' Tools > References > Microsoft Scripting Runtime
'Dim fso As Scripting.FileSystemObject
'Set fso = New Scripting.FileSystemObject

Dim wShell As Shell
Set wShell = New Shell


Dim oFN As String, nFN As String, oPath As String, nPath As String
Dim r As Range, c As Range

oPath = "x:\"
nPath = "x:\t123\"

With CreateObject("Scripting.FileSystemObject")
'With fso
Select Case True
Case Not (.FolderExists(oPath))
MsgBox "Original folder does not exist. Macro is ending!", vbCritical, oPath
Exit Sub
'Case Not (.FolderExists(oPath))
' Shell "cmd /c md " & """" & nFN & """""", vbHide '********* Make new folder path if needed. **************
'' MsgBox "New Folde does not exist. Macro is ending!", vbCritical, nPath
' Exit Sub
End Select
For Each c In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
oFN = oPath & c.Value2 & ".pdf"
nFN = nPath & c.Offset(0, 1).Value2 & ".pdf"
'.GetFile(oFN).Move nFN 'Check to see if oFN exists or nFN exists before this.
Shell "cmd /c Move /-Y " & """" & oFN & """" & " " & """" & nFN & """", vbNormalFocus
Next c
End With
End Sub
[/vba]

[Uptickdk]

Kenneth- thank you for your work. I am a little new to VBAs so please bear with me. 1. I inserted the above module and change the oPath = the the folder that has the files named by account number and changed nPath = the folder what will have the files by client name.
2. I copied into columns A and B the act numbers and corresponding act names.
3. inside the VBE I pressed the run button and get a compile error: User-defined type not defined. After hitting OK it highlights the first line Sub RenameFiles().
Could you please outline what I should do get get from the current point to the folder with named files in it.
Thanks,

[CodeNinja]

Did you add your reference? In the notes, Ken says to add microsoft scripting runtime reference...

To do so
1- open up the VBE
2- at the top menu bar select tools / References
3- Scroll down and find the microsoft scripting runtime reference
4- select it so there is a check in the checkbox next to it...
5- click ok / apply.

[Kenneth Hobs]

Sorry, I was playing with the wShell object. It is not needed.

The A2 means that A2 has the first original file name.

When you change the path names, be sure to include the trailing backslash as I did.

[vba]Sub RenameFiles()
Dim fso As Object
' Tools > References > Microsoft Scripting Runtime
'Dim fso As Scripting.FileSystemObject
'Set fso = New Scripting.FileSystemObject

Dim oFN As String, nFN As String, oPath As String, nPath As String
Dim r As Range, c As Range

oPath = "x:\"
nPath = "x:\t123\"

With CreateObject("Scripting.FileSystemObject")
'With fso
Select Case True
Case Not (.FolderExists(oPath))
MsgBox "Original folder does not exist. Macro is ending!", vbCritical, oPath
Exit Sub
'Case Not (.FolderExists(oPath))
' Shell "cmd /c md " & """" & nFN & """""", vbHide '********* Make new folder path if needed. **************
'' MsgBox "New Folde does not exist. Macro is ending!", vbCritical, nPath
' Exit Sub
End Select
For Each c In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
oFN = oPath & c.Value2 & ".pdf"
nFN = nPath & c.Offset(0, 1).Value2 & ".pdf"
'.GetFile(oFN).Move nFN 'Check to see if oFN exists or nFN exists before this.
Shell "cmd /c Move /-Y " & """" & oFN & """" & " " & """" & nFN & """", vbNormalFocus
Next c
End With
End Sub[/vba]

[Uptickdk]

OK. I have removed the wShell references see below for what script looks like now. When I run it a number of Dos shell windows open and close but there are no new files in the names file.
As an example the numbered file names look like: 12345678_06262012.pdf.

I also wanted to confirm that the oPath is for folder with the numbered named files and the nPath is for the folder with the names named files.
thanks,


[vba]Sub RenameFiles()
Dim fso As Object
' Tools > References > Microsoft Scripting Runtime
'Dim fso As Scripting.FileSystemObject
'Set fso = New Scripting.FileSystemObject

Dim oFN As String, nFN As String, oPath As String, nPath As String
Dim r As Range, c As Range

oPath = "C:\Download\6 billing"
nPath = "C:\Download\6 billing-names"

With CreateObject("Scripting.FileSystemObject")
'With fso
Select Case True
Case Not (.FolderExists(oPath))
MsgBox "Original folder does not exist. Macro is ending!", vbCritical, oPath
Exit Sub
'Case Not (.FolderExists(oPath))
' Shell "cmd /c md " & """" & nFN & """""", vbHide '********* Make new folder path if needed. **************
'' MsgBox "New Folde does not exist. Macro is ending!", vbCritical, nPath
' Exit Sub
End Select
For Each c In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
oFN = oPath & c.Value2 & ".pdf"
nFN = nPath & c.Offset(0, 1).Value2 & ".pdf"
'.GetFile(oFN).Move nFN 'Check to see if oFN exists or nFN exists before this.
Shell "cmd /c Move /-Y " & """" & oFN & """" & " " & """" & nFN & """", vbNormalFocus
Next c
End With
End Sub[/vba]

[Kenneth Hobs]

Please use VBA code tags when posting code.

When you change the path names, be sure to include the trailing backslash as I did.

Lowercase "o" means orginal file name and path. Lowercase "n" means new. Obviously, your oFN must exist. FN means path plus file name which includes file extension.

[Kenneth Hobs]

Did you note my 2nd posting of my quote as to why you had problems?

In any case, this does the same only better I think. It only pops the command window once. I also used some standard VBA methods rather than the File Scripting Object methods.

You may not have noticed but one advantage of the MD (Make Directory) command in the command shell is that if multiple folders need to be made, it makes them all at once.

I left some parts commented so that you can debug and see what is going on if you like.

[vba]Sub RenameFiles()
Dim tFN As String, iHandle As Integer
Dim oFN As String, nFN As String, oPath As String, nPath As String
Dim r As Range, c As Range

oPath = "x:\fso\" 'Requires trailing backslash.
nPath = "x:\fso\t123\" 'Requires trailing backslash.

tFN = Environ("tmp")
If tFN = "" Then tFN = Environ("temp")
tFN = tFN & "\_RenameFiles.bat"
'Debug.Print "Temp file name: ", tFN '**** Uncomment to put tFN value into Immediate window.
'Kill tFN: Exit Sub '**** Uncomment and run to quickly delete temp file if needed.

Select Case True
Case Dir(oPath, vbDirectory) = ""
MsgBox "Original folder does not exist. Macro is ending!", vbCritical, oPath
Exit Sub
Case Dir(nPath, vbDirectory) = ""
Shell "cmd /c md " & """" & nPath & """""", vbHide '********* Make new folder path if needed. **************
If Dir(oPath, vbDirectory) = "" Then
MsgBox "New Folder does not exist. Macro is ending!", vbCritical, nPath
Exit Sub
End If
End Select

iHandle = FreeFile
Open tFN For Append Access Write As #iHandle
For Each c In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
oFN = oPath & c.Value2 & ".pdf"
nFN = nPath & c.Offset(0, 1).Value2 & ".pdf"
Print #iHandle, "Move /-Y " & """" & oFN & """" & " " & """" & nFN & """"
Next c
Close #iHandle

Shell tFN, vbNormalFocus
Kill tFN 'Comment to keep temp file.
End Sub
[/vba]

[Uptickdk]

thanks will try in AM and report results. Thanks again for your time and work.

[Uptickdk]

As of this AM after updating the scrip the command window opens once quickly but no files are created in the new output folder.
I have also tried using a smaller test folder for the numbered named files and I used simple file names (123.pdf, 345.pdf, etc.)
I then created a spreadsheet with cell A1 = act number, B1 = Act name, A2 = 123, B2 = Jones, A3 = 456, B3 = Smith, etc.
I also created the output folder and updated the VBA script and used a trailing \ with the oPath and nPath and saved it.
But when I run it no newly named files are in the output folder.

Any thoughts on how to proceed?
thanks,

Below is the script I am using:
[VBA]Sub RenameFiles()
Dim tFN As String, iHandle As Integer
Dim oFN As String, nFN As String, oPath As String, nPath As String
Dim r As Range, c As Range

oPath = "C:\Download\6 billing\"
nPath = "C:\Download\6 billing-names\"

tFN = Environ("tmp")
If tFN = "" Then tFN = Environ("temp")
tFN = tFN & "\_RenameFiles.bat"
'Debug.Print "Temp file name: ", tFN '**** Uncomment to put tFN value into Immediate window.
'Kill tFN: Exit Sub '**** Uncomment and run to quickly delete temp file if needed.

Select Case True
Case Dir(oPath, vbDirectory) = ""
MsgBox "Original folder does not exist. Macro is ending!", vbCritical, oPath
Exit Sub
Case Dir(nPath, vbDirectory) = ""
Shell "cmd /c md " & """" & nPath & """""", vbHide '********* Make new folder path if needed. **************
If Dir(oPath, vbDirectory) = "" Then
MsgBox "New Folder does not exist. Macro is ending!", vbCritical, nPath
Exit Sub
End If
End Select

iHandle = FreeFile
Open tFN For Append Access Write As #iHandle
For Each c In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
oFN = oPath & c.Value2 & ".pdf"
nFN = nPath & c.Offset(0, 1).Value2 & ".pdf"
Print #iHandle, "Move /-Y " & """" & oFN & """" & " " & """" & nFN & """"
Next c
Close #iHandle

Shell tFN, vbNormalFocus
Kill tFN 'Comment to keep temp file.
End Sub
[/VBA]

[snb]

the only thing you have to do is change the path G:\OF into the path where your files are located.
the renamed files will be copied into a new subfolder (in this case G:\OF\new\)
I assume the accountnumbers to be in Column A, the accountnames in column B, starting in row 1 in sheet 'accounts'

[vba]Sub snb()
c00 = "G:\OF\"
If Dir(c00 & "new", 16) = "" Then MkDir c00 & "new"

sn = sheets("accounts").Cells(1).CurrentRegion
For j = 1 To UBound(sn)
If Dir(c00 & sn(j, 1) & ".pdf") <> "" Then FileCopy c00 & sn(j, 1) & ".pdf", c00 & "new\" & sn(j, 2) & ".pdf"
Next
End Sub[/vba]

[Kenneth Hobs]

It runs so fast sometimes it kills the BAT file before it completes execution. It now only kills (deletes) the BAT file before creating another in the next run. I also added a MsgBox to let you know if the original file does not exist.

You can now optionally do another run or edit the BAT file in your Temp folder after a run.

[vba]Sub RenameFiles_MsgMissing()
Dim tFN As String, iHandle As Integer
Dim oFN As String, nFN As String, oPath As String, nPath As String
Dim r As Range, c As Range

oPath = "x:\fso\" 'Requires trailing backslash.
nPath = "x:\fso\t123\" 'Requires trailing backslash.

tFN = Environ("tmp")
If tFN = "" Then tFN = Environ("temp")
tFN = tFN & "\_RenameFiles.bat"
'Debug.Print "Temp file name: ", tFN '**** Uncomment to put tFN value into Immediate window.
'Kill tFN: Exit Sub '**** Uncomment and run to quickly delete temp file if needed.

Select Case True
Case Dir(oPath, vbDirectory) = ""
MsgBox "Original folder does not exist. Macro is ending!", vbCritical, oPath
Exit Sub
Case Dir(nPath, vbDirectory) = ""
Shell "cmd /c md " & """" & nPath & """""", vbHide '********* Make new folder path if needed. **************
If Dir(oPath, vbDirectory) = "" Then
MsgBox "New Folder does not exist. Macro is ending!", vbCritical, nPath
Exit Sub
End If
End Select

iHandle = FreeFile
If Dir(tFN) <> "" Then Kill tFN
Open tFN For Append Access Write As #iHandle
For Each c In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
oFN = oPath & c.Value2 & ".pdf"
nFN = nPath & c.Offset(0, 1).Value2 & ".pdf"
If Dir(oFN) = "" Then
MsgBox "Skipping Move and Rename of: " & vbLf & oFN, vbCritical, "Missing Orginal File"
Else: Print #iHandle, "Move /-Y " & """" & oFN & """" & " " & """" & nFN & """"
End If
Next c
Close #iHandle

On Error Resume Next
Shell tFN, vbNormalFocus
End Sub
[/vba]

[Uptickdk]

snb your script worked great with my small test files but when I tried it with a larger folder with file names such as "12345678_06262012.pdf" it did nocreate the sub folder. is there an issue with the "_" in the file name? The program the files are exported from puts the date exported after each file name.
Any thoughts on how to resolve this?

[snb]

Please tell us the foldername in which the files reside, so we can simulate.
And please give some real filenames.

Maybe we should slow down the macro a little:


[vba]Sub snb()

c00 = "G:\OF\"

If Dir(c00 & "new", 16) = "" Then MkDir c00 & "new"

do

doevents
loop until Dir(c00 & "new", 16)<>""

sn = sheets("accounts").Cells(1).CurrentRegion

For j = 1 To UBound(sn)
If Dir(c00 & sn(j, 1) & ".pdf") <> "" Then FileCopy c00 & sn(j, 1) & ".pdf", c00 & "new\" & sn(j, 2) & ".pdf"
Next
End Sub

[/vba]

@Kenneth

Alternative using a batch file ?

[vba]Sub snb_002()
c00 = "G:\OF\"
If Dir(c00 & "new", 16) = "" Then MkDir c00 & "new"

sn = Cells(1).CurrentRegion
For j = 1 To UBound(sn)
c01 = c01 & vbCrLf & "move " & Chr(34) & c00 & Join(Application.Index(sn, j), ".pdf" & Chr(34) & " " & Chr(34) & c00 & "new\") & ".pdf" & Chr(34)
Next

CreateObject("scripting.filesystemobject").createtextfile(c00 & "hernoem.bat").write Mid(c01, 3)

Shell c00 & "hernoem.bat"
End Sub[/vba]

[Uptickdk]

The folder where the files reside is "c:\download\billing\" the orignial file names are 8 digits, then an _ , then the date (i.e. 12345678_06272012.pdf, 45678912_06272012.pdf, 14785236_06272012.pdf, etc.)
When I used a batch renaming utility and removed the last 9 characters (the "_06272012") from all the file names and then ran your script and it worked perfectly.
I then added the original file name to the new file name so the file would look like "Jones 12345678.pdf", see script below.
Would love not to have to use the batch renaming utility if possible any thoughts?
[VBA]
Sub snb()
c00 = "C:\Download\6billingnew\"
If Dir(c00 & "new", 16) = "" Then MkDir c00 & "new"

sn = Sheets("accounts").Cells(1).CurrentRegion
For j = 1 To UBound(sn)
If Dir(c00 & sn(j, 1) & ".pdf") <> "" Then FileCopy c00 & sn(j, 1) & ".pdf", c00 & "new\" & sn(j, 2) & " " & sn(j, 1) & ".pdf"
Next
End Sub
[/VBA]

[Kenneth Hobs]

If we don't know the details then our code is bound to fail.

For one instance of a wildcard name, you can use this for oFN in my code to get the "original" filename that might exist.
[vba] oFN = oPath & Dir(oPath & c.Value2 & "*.pdf")[/vba]
Dir() will return the base name of the first file to meet the prefix character name using this wild card method.

I guess you could use FileCopy if you did not want to Move the file and rename it.

[snb]

O, no...





[vba]Sub snb()
c00 = "C:\Download\6billing\"

If Dir(c00 & "new", 16) = "" Then MkDir c00 & "new"

sn = Sheets("accounts").Cells(1).CurrentRegion

For j = 1 To UBound(sn)
c01=Dir(c00 & sn(j, 1) & "*.pdf")
if c01<>"" then c02=" " & split(c01,"_")(0)
If c01<> "" Then FileCopy c00 & c01 , c00 & "new\" & sn(j, 2) & c02 & ".pdf"
Next
End Sub[/vba]

[Uptickdk]

snb no luck with your new script, I just get an empty "new" folder. If I use my bulk renaming utility and remove the "_06272012" from the file name and run it using the your new script it duplicated the .pdf at the end so I removed the "& ".pdf"" from the from the last if then statement and it works.

I guess this will have to be a 2 step process and I'll need to use the bulk renaming utility.