PDA

View Full Version : Mass file renaming



Uptickdk
06-26-2012, 10:27 AM
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
06-26-2012, 11:32 AM
Welcome to the forum!

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

Uptickdk
06-26-2012, 11:47 AM
the cells only have the base account number or the account name. No .pdf or either column

Thanks,

Kenneth Hobs
06-26-2012, 12:37 PM
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:

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

Uptickdk
06-26-2012, 01:24 PM
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
06-26-2012, 01:34 PM
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
06-26-2012, 01:34 PM
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.

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

Uptickdk
06-26-2012, 02:04 PM
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,


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

Kenneth Hobs
06-26-2012, 02:27 PM
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
06-26-2012, 04:57 PM
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.

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

Uptickdk
06-26-2012, 06:12 PM
thanks will try in AM and report results. Thanks again for your time and work.

Uptickdk
06-27-2012, 07:27 AM
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:
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

snb
06-27-2012, 07:48 AM
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'

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

Kenneth Hobs
06-27-2012, 08:06 AM
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.

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

Uptickdk
06-27-2012, 08:37 AM
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
06-27-2012, 08:57 AM
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:


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











@Kenneth

Alternative using a batch file ?

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

Uptickdk
06-27-2012, 10:31 AM
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?

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

Kenneth Hobs
06-27-2012, 11:25 AM
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.
oFN = oPath & Dir(oPath & c.Value2 & "*.pdf")
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
06-27-2012, 11:47 AM
O, no...





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

Uptickdk
06-27-2012, 12:45 PM
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.

snb
06-27-2012, 01:12 PM
Your guess isn't correct.
What is the sheetname taht contains the accountnumbers & accountnames ?
What message do you get using:

Sub snb()
c00 = "C:\Download\6billing\"
If Dir(c00 & "new", 16) = "" Then MkDir c00 & "new"


sn = Sheets("accounts").Cells(1).CurrentRegion
msgbox Ubound(sn) & "_" & ubound(sn,2)


For j = 1 To UBound(sn)
c01=Dir(c00 & sn(j, 1) & "*.pdf")
msgbox c01
If c01<>"" Then c02=" " & split(c01,"_")(0)
If c01<> "" Then FileCopy c00 & c01 , c00 & "new\" & sn(j, 2) & c02 & ".pdf"
Next
end sub

Uptickdk
06-27-2012, 02:11 PM
sheet name it accounts.

I am not getting any messages. The script run, creates the "new" folder but when you open the folder it is empty. when I remove the "_06272012" from the file name it run the script it creates the "new" folder and puts all the files in it with file name the way I wanted it "Jones 12345678.pdf"

snb
06-27-2012, 02:22 PM
Please run this code.
There must be messages when running this code.
start the code in the VBEditor.using F8 (step-by step)


Sub snb()
c00 = "C:\Download\6billing\"
If Dir(c00 & "new", 16) = "" Then MkDir c00 & "new"

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

msgbox UBound(sn) & "_" & UBound(sn,2)

For j = 1 To UBound(sn)

c01=Dir(c00 & sn(j, 1) & "*.pdf")
msgbox c01 ,,sn(j,1)
If c01<>"" Then c02=" " & split(c01,"_")(0)
If c01<> "" Then FileCopy c00 & c01 , c00 & "new\" & sn(j, 2) & c02 & ".pdf"
Next
End sub

Uptickdk
06-27-2012, 06:38 PM
OK I ran the script in VBEditor using F8
The first error happens at: MsgBox UBound(sn) & "_" & UBound(sn, 2) a error box opens with 290_2 in it and an OK button.
The next error happens at: If c01 <> "" Then c02 = " " & Split(c01, "_")(0) there isn't a message just an error box with the first file name (from box A1) and an OK button. Then when is circles back to the same line as above and you get the same box but this time it has the file name from B2, this goes on until is runs through all the file names in column A

snb
06-28-2012, 12:06 AM
These are no error boxes but messageboxes: just what I wanted.
It means: you have 290 accounts.

We are going to reduce the code to:

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)
If Dir(c00 & sn(j, 1) & "*.pdf")<> "" Then FileCopy c00 & Dir(c00 & sn(j, 1) & "*.pdf") , c00 & "new\" & sn(j, 2) & " " & sn(j,1) & ".pdf"
Next
End sub

Please copy paste this code into the macromodule.
then run it form the VBEditor, using F8 (step by step) or F5 (all in one)

Uptickdk
06-28-2012, 07:36 AM
Ran it step by stem then all in one and no errors. It did create the "new" folder but no files inside it.

shrivallabha
06-28-2012, 08:09 AM
Read this thread. I think it 'seriously' comes close to your requirement.
Copy Files From One Location To Another (http://www.vbaexpress.com/forum/showthread.php?t=36352)

Kenneth Hobs
06-28-2012, 08:12 AM
You should post a sample workbook. I suspect that it has things in it that we did not know. e.g. CurrentRegion will return an unexpected range or no range at all if you don't understand how it works.

You will notice that my code iterated from A2 to the last cell with data from the bottom up. This means that if you had a blank cell between, then that needs to be addressed in the code. Another way to do that is by going down from A2 to the last cell with data. The problem with that method is if A3 is blank, you could have a million cells in that range. It is all about knowing your setup as we can only guess at so much.

snb
06-28-2012, 08:14 AM
You didn't alter anything in the code ?

Uptickdk
06-28-2012, 09:14 AM
snb my apologies you were again correct I changed the folder to the one that contained the files exported from the bulk renaming utility where the file names were only "12345678.pdf"
Once I changed the script to the correct folder it worked beautifully. Below is your script I used.
Thank you again and sorry for the extra work it was my bad.
Uptickdk


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

snb
06-28-2012, 09:34 AM
Thalassa, Thalassa....