GetSaveAsFileName | Mac Excel Automation

GetSaveAsFileName on a Mac

We can use the custom code below to let the user browse to a location and enter a file name. The result(path/filename) we use in the code that really save the file. There are a few nice parameters that you can use with GetSaveAsFileName that all work OK in Windows but not on a Mac, Filefilter is a very important one that is not working on a Mac. The basic example code below is something that is close to what you can do in Excel for Windows but if you have suggestions please let me know.

Below you find a macro and custom function that you can use to let the user save the ActiveWorkbook in the format you want and get the correct FileFormat of the selected extension. This is important because the extension and the FileFormat must match, if not you can't open the saved file.

You see that it is one line of code that you can use in your own code to call the custom function to save the ActiveWorkbook. In the macro below that call the function I add one line that create a workbook with one sheet each time you run the macro so it is easy to test the function. Please read the comments in the macro good so you know how to use it.

Test macro and custom function

Sub TestMacGetSaveAsFilenameExcelExample()
'If FileExtension = "" you can save in the following formats : xls, xlsx, xlsm, xlsb
'You can also set FileExtension to the extension you want like "xlsx" for example
'Note : this macro use the custom function named : MacGetSaveAsFilenameExcel
'Do not forget to copy this function with this macro in your code module.

    'For testing we add a new workbook with one sheet
    Workbooks.Add (1)

    'Now we call the custom GetSaveAsFilename function
    MacGetSaveAsFilenameExcel MyInitialFilename:="MyTestName", FileExtension:="xlsx"

End Sub
 

Function MacGetSaveAsFilenameExcel(MyInitialFilename As String, FileExtension As String)
'Ron de Bruin, 03-April-2015
'Custom function for the Mac to save the activeworkbook in the format you want.
'If FileExtension = "" you can save in the following formats : xls, xlsx, xlsm, xlsb
'You can also set FileExtension to the extension you want like "xlsx" for example
    Dim FName As Variant
    Dim FileFormatValue As Long
    Dim TestIfOpen As Workbook
    Dim FileExtGetSaveAsFilename As String

Again: FName = False
    
    'Call VBA GetSaveAsFilename
    'Note: InitialFilename is the only parameter that works on a Mac
    FName = Application.GetSaveAsFilename(InitialFileName:=MyInitialFilename)

    If FName <> False Then
        'Get the file extension
        FileExtGetSaveAsFilename = LCase(Right(FName, Len(FName) - InStrRev(FName, ".", , 1)))

        If FileExtension <> "" Then
            If FileExtension <> FileExtGetSaveAsFilename Then
                MsgBox "Sorry you must save the file in this format : " & FileExtension
                GoTo Again
            End If
            If ActiveWorkbook.HasVBProject = True And LCase(FileExtension) = "xlsx" Then
                MsgBox "Your workbook have VBA code, please not save in xlsx format"
                Exit Function
            End If
        Else
            If ActiveWorkbook.HasVBProject = True And LCase(FileExtGetSaveAsFilename) = "xlsx" Then
                MsgBox "Your workbook have VBA code, please not save in xlsx format"
                GoTo Again
            End If
        End If

        'Find the correct FileFormat that match the choice in the "Save as type" list
        'and set the FileFormatValue, Extension and FileFormatValue must match.
        'Note : You can add or delete items to/from the list below if you want.
        Select Case FileExtGetSaveAsFilename
        Case "xls": FileFormatValue = 57
        Case "xlsx": FileFormatValue = 52
        Case "xlsm": FileFormatValue = 53
        Case "xlsb": FileFormatValue = 51
        Case Else: FileFormatValue = 0
        End Select
        If FileFormatValue = 0 Then
            MsgBox "Sorry, FileFormat not allowed"
            GoTo Again
        Else
            'Error check if there is a file open with that name
            Set TestIfOpen = Nothing
            On Error Resume Next
            Set TestIfOpen = Workbooks(LCase(Right(FName, Len(FName) - InStrRev(FName, _
                Application.PathSeparator, , 1))))
            On Error GoTo 0

            If Not TestIfOpen Is Nothing Then
                MsgBox "You are not allowed to overwrite a file that is open with the same name, " & _
                "use a different name or close the file with the same name first."
                GoTo Again
            End If
        End If

        'Now we have the information to Save the file
        Application.DisplayAlerts = False
        On Error Resume Next
        ActiveWorkbook.SaveAs FName, FileFormat:=FileFormatValue
        On Error GoTo 0
        Application.DisplayAlerts = True
    End If

End Function