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:
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, _ "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.