John Carty
John Carty

Reputation: 262

VBA Custom Save

I have a file that I am trying to force to do version control. The user has requested it to work as follows: when they save the file excel should save the original version of the file to one that has the date and time in the file name, then have the one with the updates to have no date and time after it.

I wrote the vba to handle most of this, I just can't get it to play nicely with Sub Workbook_BeforeSave.

Here is what I have for saving, this works as intended if I just run the VersionControl() macro.

Sub VersionControl()
    Dim myFileName As String, originalName As String, tempFileName As String, wbOld As Workbook
    originalName = ThisWorkbook.FullName
    myFileName = NewPath()
    Application.DisplayAlerts = False
    tempFileName = ThisWorkbook.Path & "\Version_Control_Temp.xlsm"
    ActiveWorkbook.SaveAs Filename:=tempFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Set wbOld = Workbooks.Open(originalName, False, True)
    wbOld.SaveAs Filename:=myFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    wbOld.Close
    ActiveWorkbook.SaveAs Filename:=originalName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub


Function NewPath() As String
    Dim testString As String, fullPath As String
    testString = Year(Now) & "_" & Format(Month(Now), "00") & "_" & Format(Day(Now), "00") & "_" & Hour(Now) & Minute(Now)
    fullPath = ThisWorkbook.FullName
    fullPath = Left(fullPath, Len(fullPath) - 5) & "_" & testString & ".xlsm"
    NewPath = fullPath
End Function

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
        Cancel As Boolean)
    If Not SaveAsUI Then
        Call VersionControl
        Cancel = True
    End If
End Sub

The problem I seem to be running into is if I call VersionControl() from inside of the Workbook_BeforeSave event trigger the tries to run the VersionControl() for every SaveAs I do.

Upvotes: 2

Views: 257

Answers (1)

urdearboy
urdearboy

Reputation: 14590

To avoid the infinite loop here, disable events before doing another save


Sub VersionControl()
   Application.EnableEvets = False

       'Your code goes here

   Application.EnableEvents = True
End Sub

Upvotes: 2

Related Questions