Save File with Date and Version Number

[phill63]

So I have a Macro that is used to save backups of files. The intention is for it to save a new file with today's date and a version number. So if it is the first time it was backed up today the file name will have "_1" at the end of the date, the second time will be "_2" and so on.

The macro works fine for the the first two files of the day. But if I try to save a third back up excel pops up a message that says the file already exists would I like to save over it.

I have no idea where I messed up my loop that it is getting stuck trying to save as version 2 everytime after the second instead of continuing to update to the new version.

If anyone can help fix this or knows a better way to accomplish this your help would be greatly appreciated.

Sub SaveFlowsInputBackup()
    Dim i As Long
    Dim FName As String
    Dim FPath As String
    Dim FNum As String
    
    FPath = "G:\DATA\LPL\OPSOPM\Flows Folder\Flows Backups\Flows Input Backup"
    FName = "Flows Input Backup" & Format(Date, " MM-DD-YYYY")
    
    Set NewBook = Workbooks.Add
    
    i = 1
    Do
        If i = 1 Then
            FNum = "_1" & ".xls"
        Else
            FNum = "_" & i
        End If
        
        If Dir(FPath & "\" & FName & FNum) = "" Then
            Exit Do
        Else
            i = i + 1
        End If
    Loop
    
    ThisWorkbook.Sheets(1).Copy Before:=NewBook.Sheets(1)
    
    NewBook.SaveAs FileName:=FPath & "\" & FName & FNum
    NewBook.Close
   
End Sub

 

[John_w]

See if http://www.mrexcel.com/forum/excel-questions/493666-save-file-folder.html#post2437426 helps.

 

[phill63]

Thanks for the reply John. I'm not exactly sure what you mean though?

 

[John_w]

The loop generates the next sequentially numbered file name. Ok, it doesn't include the date, but I thought it would get you started.

Try this:

Sub SaveFlowsInputBackup()
    
    Dim n As Integer
    Dim backupFile As String
    Dim newBook As Workbook
    
    n = 0
    Do
        n = n + 1
        backupFile = "G:\DATA\LPL\OPSOPM\Flows Folder\Flows Backups\Flows Input Backup\Flows Input Backup " & Format(Date, "MM-DD-YYYY") & "_" & n & ".xls"
    Loop Until Dir(backupFile) = ""
    
    Set newBook = Workbooks.Add
    
    ThisWorkbook.Sheets(1).Copy Before:=newBook.Sheets(1)
    
    newBook.SaveAs fileName:=backupFile
    newBook.Close
   
End Sub

 

[phill63]

Thank you so much for your help again John!! This worked perfectly and substantially faster than the way I had it coded before.