Save As with Version Control

[Paul_11]

I have a piece of code which copies a worksheet from an Excel workbook and saves this as a text file with the file path and file name being dynamically pulled from two cells.

I want to know how to adjust this code so when the file already exists a new version will be saved. Ie: Initially the code will save the file as "2016_11_17_v1" but if this exists save as "2016_11_17_v2" etc.

Is this possible? Any help would be MUCH appreciated.

Sub SaveAs()


SaveAsFilePath = Range("A1") & "\" & Range("A2") & ".txt"
If Range("Operator_Check") = 1 Then
MsgBox "Operators missing from rates table"
Exit Sub
Else
On Error Resume Next
    ActiveWorkbook.Worksheets("Wokrsheet_1").Copy
    ActiveWorkbook.SaveAs SaveAsFilePath, xlTextWindows
    ActiveWorkbook.Close
    
On Error GoTo 0
End If
    
End Sub

 

[AlphaFrog]

[color=darkblue]Sub[/color] SaveAsText()
    
    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color], strBaseName [color=darkblue]As[/color] [color=darkblue]String[/color], strFileName [color=darkblue]As[/color] [color=darkblue]String[/color], i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]If[/color] Range("Operator_Check") = 1 [color=darkblue]Then[/color]
        MsgBox "Operators missing from rates table"
        [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=darkblue]Else[/color]
    
        strPath = Range("A1").Value & "\"
        strBaseName = Format(Date, "yyyy_mm_dd_v")
        
        [color=darkblue]Do[/color]
            i = i + 1
            strFileName = strPath & strBaseName & i & ".txt"
        [color=darkblue]Loop[/color] [color=darkblue]Until[/color] Dir(strFileName) = ""
        
        Application.ScreenUpdating = [color=darkblue]False[/color]
        ActiveWorkbook.Worksheets("Wokrsheet_1").Copy
        ActiveWorkbook.SaveAs strFileName, xlTextWindows
        ActiveWorkbook.Close [color=darkblue]False[/color]
        Application.ScreenUpdating = [color=darkblue]True[/color]
        
        MsgBox strFileName, vbInformation, "Copy Saved As Text File"
        
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[dmt32]

Hi,
not tested but see if this update to your code does what you want:

Sub SaveAs()
    Dim SaveAsFilePath As String, FileExt As String
    Dim ver As Integer
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    FileExt = ".txt"
    
    SaveAsFilePath = ws.Range("A1").Value & "\" & ws.Range("A2").Value
    
    If ws.Range("Operator_Check") = 1 Then
    
        MsgBox "Operators missing from rates table.", 16, "Operators Missing"
        
        Exit Sub
        
    Else
    
        On Error GoTo myerror
        Application.ScreenUpdating = False
        
        While Not Dir(SaveAsFilePath & FileExt, vbDirectory) = vbNullString
            ver = ver + 1
            SaveAsFilePath = SaveAsFilePath & "_v" & ver
        Wend
    
        ThisWorkbook.Worksheets("Wokrsheet_1").Copy
        
        With ActiveWorkbook
            .SaveAs SaveAsFilePath & FileExt, xlTextWindows
            .Close False
        End With
         
    End If
    
myerror:
    Application.ScreenUpdating = True
     If Err > 0 Then MsgBox (Error(Err)), 48, "Error" Else MsgBox "File Saved", 48, "File Saved"
End Sub

Change sheet name shown in RED as required.

Dave

 

[Paul_11]

Worked perfectly Alphafrog. Thanks a heap!