CODEWITHSUNDEEP
excelvba
Mike Eburne
Mike Eburne

Reputation: 351

Excel VBA prevent SaveAs .xlsx

I produce a suite of Scorecard calculators with macros. I distribute the workbooks as .xls files. However, sometimes a user will save the workbook as an .xlsx file and thereby removing all the VBA code and macros. The built-in functions obviously no longer work.

Is there any way I can make the standard Excel SaveAs function exclude .xlsx as an option?

Upvotes: 0

Views: 1605

Answers (1)

MikeD
MikeD

Reputation: 8941

You may replace the standard FileSave dialog by your own. Unfortunately you cannot manipulate the Filter list to remove anything but ".xlsm" and ".xls" but you can catch the selected file name and act accordingly ...

suggestion:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FD As FileDialog, FTyp As Long

    MsgBox "Sub Workbook_BeforeSave"

    ' this Sub will never save, we save through the Dialog box below
    Cancel = True

    ' reference a SaveAs Dialog
    Set FD = Application.FileDialog(msoFileDialogSaveAs)
    FD.Show

    If FD.SelectedItems.Count = 0 Then
        MsgBox "Nothing chosen"
        Exit Sub
    Else
        ' check for proper extension
        If Right(FD.SelectedItems(1), 3) = "xls" Or Right(FD.SelectedItems(1), 4) = "xlsm" Then
            MsgBox "saving as " & FD.SelectedItems(1)

            If Right(FD.SelectedItems(1), 3) = "xls" Then
                ' different enum before Excel 2007
                If Val(Application.Version) < 12 Then
                    FTyp = -4143           ' xls pre-2007
                Else
                    FTyp = 56              ' xls post-2007
                End If
            Else
                FTyp = 52                  ' xlsm post-2007
            End If

            ' we don't want to come here again, so temporarily switch off event handling
            Application.EnableEvents = False
            Me.SaveAs FD.SelectedItems(1), FTyp
            Application.EnableEvents = True

        Else
            MsgBox "selected wrong file format ... not saving"
        End If
    End If

End Sub

Upvotes: 2

Related Questions