File Rename Macro?

[Longcut]

I have a listing of excel files of invoices named numerically and would like to rename them with their current number designation plus the customer name from a specific cell within the file. Then resave with the new name.

Example
Current: 21453
New: 21453 Smith and Associates

Thanks

 

[Jay Petrulis]

Hi,

Here is one way. Modify as necessary.

<pre>Sub test()
Dim x, y, invoicenum, refname

With Application
x = .DefaultFilePath
y = .PathSeparator
End With

invoicenum = 21453
refname = ActiveSheet.Range("A1")
ActiveWorkbook.SaveAs x & y & invoicenum & " " & refname

End Sub</pre>

 

[s-o-s]

On 2002-09-17 12:13, Longcut wrote:
I have a listing of excel files of invoices named numerically and would like to rename them with their current number designation plus the customer name from a specific cell within the file. Then resave with the new name.

Example
Current: 21453
New: 21453 Smith and Associates

Thanks

Hi Longcut,

Paste the attached code into a module (Alt+F11)

The macro will search through numerically all the files in the current directory and rename them with the Numeric value plus the name from (in this case) cell A6 from sheet1 instructions are included for changing.

If your invoices do not start from 1 then change the filecount in the line

filecount = 0 to the number 1 below your actual starting point.

All the files need to be present as soon as there is a break in the list an error will be hgenerated causing the macro to see this as the end.

Option Explicit

Sub RenameFiles()
Dim FileCount As Integer
Dim FilNam, NewNam As String
FileCount = 0

LoopHere:
FileCount = FileCount + 1
FilNam = FileCount & ".xls"
On Error GoTo Thend
    Workbooks.Open FileName:=FilNam
    
' Change the Cell in A6 to the cell in your spreadsheet containing the co. address
' If you are not using Sheet1 as the sheet name change this to the name of your sheet
' in the numeric files. If these change then you will have to program that to possibly
' by picking up the activesheet name of the index(1) sheet repost if this is the case.

    NewNam = FileCount & " " & Sheets("Sheet1").Range("A6").Value
    ActiveWorkbook.SaveAs FileName:=NewNam, FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWindow.Close
GoTo LoopHere

Thend:

End Sub

 

[Longcut]

Thanks Sean!
This did the trick but there were a few set backs:
1. Typos in macro
2.When renaming a file where the customer name ended in a period (ie: Smith Company, Inc.) the file was saved without an extension. So I created a macro outside of Excel that renamed each file adding the .xls.
3. If there was an older Excel format file the macro would not proceed due to the popup about saving as new format. (havent found a work around yet!)

Thanks for your help!
Longcut