One of the most important things a VBA procedure can do is save a file, especially a file that’s been substantially modified by that procedure.

This functionality is even better if the user is given the opportunity to specify a path and file name.  You can simply pop up Excel’s own Save As dialog:

Application.Dialogs(xlDialogSaveAs).Show sFileName

This approach is fine for simple applications, but it saves the file before execution returns to the calling procedure. This may not be what you want to do with the file and file name.

Excel’s VBA object model has a more flexible approach. The GetSaveAsFilename method opens a Save As dialog and gives the user control over directory and file name. GetSaveAsFilename does not save the file, but only retrieves the combined path and file name and returns it to the executing procedure for further use. If the user cancels, the function returns the string “False” instead of a filename.

Below is an implementation of GetSaveAsFilename that I’ve wrapped in a function called GSAFN. The function  takes a file name and path, which are used as the defaults in the Save As dialog.  If the file name entered by the user matches an existing file name, it asks the user what to do: overwrite the existing file, enter another file name, or cancel the save operation. If the user cancels the save, GSAFN returns a zero length string.

Function GSAFN(sFileName As String, sPathName As String) As String
  Dim sFullName As String
  Dim sPrompt As String
  Dim sCurDir As String
  Dim iOverwrite As Long

  If ActiveWorkbook Is Nothing Then GoTo ExitSub

  ' save current directory, restore it later
  sCurDir = CurDir

  ' switch to desired directory
  If Len(sPathName) > 0 Then
    ChDrive sPathName
    ChDir sPathName
  End If

  ' loop until unique name is entered
  Do
    sFullName = Application.GetSaveAsFilename(sFileName, _
        "Excel Files (*.xls),*.xls", , _
        "Browse to a folder and enter a file name")

    If Len(sFullName) = 0 Then GoTo ExitSub
    If sFullName = "False" Then GoTo ExitSub

    ' if name is unique, exit loop and save file
    If Not FileExists(sFullName) Then Exit Do

    ' tell user that the filename is in use

    ' parse filename
    sFileName = FullNameToFileName(sFullName)
    sPathName = FullNameToPath(sFullName)

    ' construct message
    sPrompt = "A file named '" & sFileName & "' already exists in '" _
        & sPathName & "'"
    sPrompt = sPrompt & vbNewLine & vbNewLine & _
        "Do you want to overwrite the existing file?"

    ' ask user what to do
    iOverwrite = MsgBox(sPrompt, vbYesNoCancel + vbQuestion, _
        "Image File Exists")

    Select Case iOverwrite
      Case vbYes
        ' overwrite existing file
        Exit Do
      Case vbNo
        ' do nothing, loop again to get new filename
      Case vbCancel
        ' bail out
        GoTo ExitSub
    End Select
  Loop

  ' finally, save the file using filename from above
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs sFullName
  Application.DisplayAlerts = True

  GSAFN = sFullName

ExitSub:
  ' restore previous current directory
  ChDrive sCurDir
  ChDir sCurDir

End Function

The following procedures are used in the main procedure above. The FileExists function is more flexible than simply using Dir, because using it does not reset the initial file spec used in Dir. The FullNameToFileName and FullNameToPath functions parse the combined path and file name into a separate path and file name, making the GSAFN function work more easily. They were originally written for Excel 97, before VBA had the RevInStr string function; don’t laugh at the antiquated syntax, because they still work just fine.

Function FileExists(ByVal FileSpec As String) As Boolean
  ' Karl Peterson, Former MS VB6 MVP
  Dim Attr As Long
  ' Guard against bad FileSpec by ignoring errors
  ' retrieving its attributes.
  On Error Resume Next
  Attr = GetAttr(FileSpec)
  If Err.Number = 0 Then
    ' No error, so something was found.
    ' If Directory attribute set, then not a file.
    FileExists = Not ((Attr And vbDirectory) = vbDirectory)
  End If
End Function

Function FullNameToFileName(sFullName As String) As String
  Dim k As Integer
  Dim sTest As String
  If InStr(1, sFullName, "[") > 0 Then
    k = InStr(1, sFullName, "[")
    sTest = Mid(sFullName, k + 1, InStr(1, sFullName, "]") - k - 1)
  Else
    For k = Len(sFullName) To 1 Step -1
      If Mid(sFullName, k, 1) = "\" Then Exit For
    Next k
    sTest = Mid(sFullName, k + 1, Len(sFullName) - k)
  End If
  FullNameToFileName = sTest
End Function

Function FullNameToPath(sFullName As String) As String
  ''' does not include trailing backslash
  Dim k As Integer
  For k = Len(sFullName) To 1 Step -1
    If Mid(sFullName, k, 1) = "\" Then Exit For
  Next k
  If k < 1 Then
    FullNameToPath = ""
  Else
    FullNameToPath = Mid(sFullName, 1, k - 1)
  End If
End Function

GSAFN is called as follows:

Sub TestGSAFN()
  Dim sFile As String
  sFile = GSAFN("testfile.xls", "C:\Temp")
  If Len(sFile) > 0 Then
    MsgBox "File successfully saved"
  Else
    MsgBox "File was not saved"
  End If
End Sub

GSAFN and the supporting functions are so helpful that I include them in a general Tools module which I drop into each new project I develop.

Related Posts:

• File Name Functions
• Enhanced Export Chart Procedure
• Get Open or Save-As Filename
• Export Chart as Image File
• VBA to Split Data Range into Multiple Chart Series
• UDF to Calculate an Arbitrary Formula
• List VBA Procedures by VBA Module and VB Procedure
• Extend Range to Add New Series (VBA)
• Validation Functions
• Excel Templates Demystified