Rename and save without overwriting the exisiting file

[Thulasiram]

I have a macro (given below) that saves a new workbook with the name
Book1. Next time when the macro is executed, how the code should be
tweaked such that the new workbook is saved in a different name? I
tried using "i" loop but that doesnt merge well in my case as this
part is a part of a huge code. I

In short, I would like to have a macro for the following algorithmn
for this one:
If the filename is already found, then add any character (number,
alphabet) to save it as a different file name.

For example, initial save gives Book1.xls.
Next save finds Book1.xls, the filename should be renamed as
Book11.xls or Book1a.
Next save finds Book1 and Book11/Book1a. So, the filename should be
renamed as Book111 or Book11a or....
So on....

Can someone please help me with the macro?

ActiveWorkbook.SaveAs Filename:= _
"C:\Book1.xls", FileFormat _
:=xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False

Thanks!
Thulasiram

 

[Guest]

Hi,

This should do the trick for you. Note that it is not necessary to supply
the .xls extension in the save part. Excel looks after that and it makes it
easier to create the new filename without contending with the file extension.

Sub Save_As_NewName()

Dim strInitName As String
Dim strNewName As String
Dim intAppend As Integer
Dim myFile As String

strInitName = "C:\Book1"
strNewName = strInitName

Do
myFile = Dir(strNewName & ".xls")
If myFile <> "" Then
intAppend = intAppend + 1
strNewName = strInitName & intAppend
End If
Loop While myFile <> ""

ActiveWorkbook.SaveAs Filename:= _
strNewName, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:= _
False, CreateBackup:=False

End Sub

Regards,

OssieMac

 

[Thulasiram]

OssieMac!!!!!!!!

You rock!! This code definitely does the trick for me... Thanx a
zillionfor the quick response and helping me out! Can you please
explain what goin on the Do loop..

 

[Thulasiram]

To fit my query, I've added Workbooks.Add between the Do loop and the
ActiveWorkbook.SaveAs Filename:= _

Thanks OssieMac!

 

[Guest]

Hi again,

Hope the comments in the code answers you question as to what is happening
in the loop.

Sub Save_As_NewName()

Dim strInitName As String
Dim strNewName As String
Dim intAppend As Integer
Dim myFile As String

'Note next two variables start with same value
strInitName = "C:\Book1"
strNewName = strInitName


Do
'Dir function searches for the file description
'which has been concatenated from strNewName
'plus the file extension (First search is for
'"C:\Book1.xls")
'if file found then myFile = filename so
'therefore it exists. If not found then myFile
'is empty or = ""

myFile = Dir(strNewName & ".xls")

'If myFile is not empty then increment intAppend
'and concatenate it with strInitName and save the
'concatenated string to strNewName so on the first
'loop strNewName would become "C:\Book11".
'Note that strInitName remains unchanged.
'On the next loop if "C:\Book11" exists then
'strNewName would become "C:\Book12".
If myFile <> "" Then
intAppend = intAppend + 1
strNewName = strInitName & intAppend
End If

'Next line will cause the code to loop if myfile
'is not empty. If myFile is empty then it has not
'found the most recent strNewName therefore it does
'not exist and can be used as the new file name.
Loop While myFile <> ""

ActiveWorkbook.SaveAs Filename:= _
strNewName, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:= _
False, CreateBackup:=False

End Sub

Regards,

OssieMac

 

[Thulasiram]

Hi again,

Hope the comments in the code answers you question as to what is happening
in the loop.

Sub Save_As_NewName()

Dim strInitName As String
Dim strNewName As String
Dim intAppend As Integer
Dim myFile As String

'Note next two variables start with same value
strInitName = "C:\Book1"
strNewName = strInitName

Do
'Dir function searches for the file description
'which has been concatenated from strNewName
'plus the file extension (First search is for
'"C:\Book1.xls")
'if file found then myFile = filename so
'therefore it exists. If not found then myFile
'is empty or = ""

myFile = Dir(strNewName & ".xls")

'If myFile is not empty then increment intAppend
'and concatenate it with strInitName and save the
'concatenated string to strNewName so on the first
'loop strNewName would become "C:\Book11".
'Note that strInitName remains unchanged.
'On the next loop if "C:\Book11" exists then
'strNewName would become "C:\Book12".
If myFile <> "" Then
intAppend = intAppend + 1
strNewName = strInitName & intAppend
End If

'Next line will cause the code to loop if myfile
'is not empty. If myFile is empty then it has not
'found the most recent strNewName therefore it does
'not exist and can be used as the new file name.
Loop While myFile <> ""

ActiveWorkbook.SaveAs Filename:= _
strNewName, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:= _
False, CreateBackup:=False

End Sub

Regards,

OssieMac

Perfect reply! Thanks a lot for clarifying the code.

Regards,
-T