save sheets as new version: changes required in existing macro

[aravindhan_3]

Hi,

I have the below code which saves the sheets as new workbook with the password.However the macro overwrites the file if already exists.
How do we make changes on this to save as new file with version # say filel v.1.xls, file v.2 etc.xls. each time the file is saved new should be created and not overwrite the exisiting file.

code
[vba]Sub Save_Archive()
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Dim The_Filename As String 'Name of file to save
Dim The_Dir As String 'Name of directory in which to save the file
Sheets("Blank BCS Wk1").Visible = True
Sheets("Blank BCS Wk1").Select
ActiveSheet.Copy
Range("M1").Select
'The_Filename = (Range("d5")) & " " & (Range("f5")) & ".xls"
The_Filename = (Range("M1")) & ".xls"
'Set directory within C drive
The_Dir = "C:\Documents and Settings\MT45\Desktop\16.11.09\"

ActiveWorkbook.SaveAs Filename:=The_Dir & The_Filename, FileFormat:=xlNormal _
, Password:="country", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
With ActiveSheet.UsedRange
.Value = .Value
End With
ActiveWorkbook.Save
ActiveWorkbook.Close False

With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
Sheets("Blank BCS Wk1").Visible = False
End Sub

[/vba]

thanks for you help
arvind

[GTO]

Hi Arvind,

You could use FileSystemObject's 'FileExists' method. Along the lines of:
[vba]
Option Explicit

Sub CallIt()
Dim wksToCreateFileFrom As Worksheet
Dim wbNew As Workbook
Dim bolFilename As Boolean
Dim i As Long

Dim The_Filename As String, The_Dir As String

Const FILE_NAM As String = "MyFile"

Set wksToCreateFileFrom = ThisWorkbook.Worksheets("Sheet1")
Set wbNew = Workbooks.Add(xlWBATWorksheet)

wksToCreateFileFrom.Copy , wbNew.Worksheets(1)
Application.DisplayAlerts = False
wbNew.Worksheets(1).Delete
Application.DisplayAlerts = True

The_Dir = ThisWorkbook.Path & "\"
The_Filename = FILE_NAM

'// Call for a filename until we don't find an existing, then saveas. //
Do
bolFilename = FileExists(The_Dir, The_Filename, ".xls")
If bolFilename Then
i = i + 1
The_Filename = FILE_NAM & "_v" & i
Else
wbNew.SaveAs The_Filename
wbNew.Close False
End If
Loop While bolFilename
End Sub

Function FileExists(Path As String, FName As String, Ext As String) As Boolean
FileExists = CreateObject("Scripting.FileSystemObject").FileExists(Path & FName & Ext)
End Function
[/vba]

Hope that helps,

Mark