title: Update the file name on Workbook_BeforeSave
body: <p>I'm trying to have Excel save a file with a unique name whenever it's saved.<br>
    This will mostly be used within Excel 2003, but must also work on 2010.</p>
  
  <p>The idea is that the user opens a template file and if they click 'Save' or just close the workbook it will save as template_1, template_2, etc.</p>
  
  <p><strong>This works fine if they click 'Save', but if they close the file it will ask if you want to save changes on the original file, saves it under the new name and then ask if the user wants to save changes... and then saves and asks if the user wants to save changes, and so on.</strong>  Obviously, I only want it to save the once and then close - but it doesn't.</p>
  
  <p>I've tried setting the <code>Saved</code> property to TRUE. I've tried <code>Cancel = True</code> after the save but this causes Excel to crash with a <strong>Excel has encountered a problem and really needs to screw your day up</strong> type message.</p>
  
  <p>In the code below I've tried removing the <code>Saved=TRUE</code> and the <code>Cancel=TRUE</code>, I've tried moving them around - Cancel before the Save, Cancel after the Save but within the <code>If...End If</code> block, before and after the <code>EnableEvents</code> code:</p>
  
  <pre><code>Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
      Dim NewFileName As String
  
      On Error GoTo ERROR_HANDLER
  
      NewFileName = GenerateUniqueName(ThisWorkbook.FullName)
      If NewFileName &lt;&gt; "" Then
          Application.EnableEvents = False
          ThisWorkbook.SaveAs NewFileName, ThisWorkbook.FileFormat
          ThisWorkbook.Saved = True
          Application.EnableEvents = True
      End If
  
  FastExit:
  
      Cancel = True
  
      On Error GoTo 0
      Exit Sub
  
  ERROR_HANDLER:
      MsgBox "Error " &amp; Err.Number &amp; vbCr &amp; _
          " (" &amp; Err.Description &amp; ") in procedure ThisWorkbook.Workbook_BeforeSave." &amp; vbCr &amp; vbCr &amp; _
          "DOCUMENT NOT SAVED.", vbCritical + vbOKOnly
      Application.EnableEvents = True
      Resume FastExit
  
  End Sub
  </code></pre>
  
  <p>The <code>GenerateUniqueName</code> code is below - this assumes the file name doesn't contain an underscore character and appends the number to the file name as _1, _2, etc:</p>
  
  <pre><code>'----------------------------------------------------------------------
  ' GenerateUniqueName
  '
  '   Generates a file name that doesn't exist by appending a number
  '   inbetween the base name and the extension.
  '   Example: GenerateUniqueName("c:\folder\file.ext") = "c:\folder\file_4.ext"
  '----------------------------------------------------------------------
  Function GenerateUniqueName(FullFileName As String, Optional fAlwaysAddNumber As Boolean) As String
  
      Dim oFSO As Object
      Set oFSO = CreateObject("Scripting.FileSystemObject")
  
      If Not oFSO.FileExists(FullFileName) And Not fAlwaysAddNumber Then
          GenerateUniqueName = FullFileName
      Else
          Dim strExt As String
          Dim strNonExt As String
          Dim strBaseName As String
          Dim strNewName As String
          Dim i As Integer
          strExt = oFSO.GetExtensionName(FullFileName)
          If strExt &lt;&gt; "" Then
              strBaseName = oFSO.GetBaseName(FullFileName)
              If InStrRev(strBaseName, "_") &gt; 0 Then
                  i = Val(Mid(strBaseName, InStrRev(strBaseName, "_") + 1, Len(strBaseName)))
                  strBaseName = Left(strBaseName, InStrRev(strBaseName, "_") - 1)
              End If
              strNonExt = oFSO.buildpath(oFSO.GetParentFolderName(FullFileName), strBaseName)
              Do
                  i = i + 1
                  strNewName = strNonExt &amp; "_" &amp; i &amp; "." &amp; strExt
              Loop While oFSO.FileExists(strNewName)
              GenerateUniqueName = strNewName
          Else
              MsgBox "File name must contain a file extension." &amp; vbCr &amp; _
                  "e.g. .xls or .xlsx", vbCritical + vbOKOnly
              GenerateUniqueName = ""
          End If
      End If
  
      Set oFSO = Nothing
  
  End Function
  </code></pre>