用于将活动 Excel 文件以 pdf 或 Excel 形式通过电子邮件发送的 VBA 代码

Question

I have code for a command button to save an active Excel file as pdf and then open it in Outlook for the user to send as an email.

However, this requires the user to save the file as a pdf before it opens it in Outlook. It works perfectly if the user wants to save a copy to their files.

What if the user wants to use the submit button but doesn't want to save a copy off and cancels that process? With the code I have below, it just fails out.

Is it possible to code it so that if the user decides they don't want to save a copy off, that it will default to send an email with the active excel file attached instead?

Private Sub CommandButton1_Click()
'
    Dim OutApp As Object
    Dim OutMail As Object
    Dim v As Variant
    v = Application.GetSaveAsFilename(Range("A4").Value, "PDF Files (*.pdf), *.pdf")

    If Dir(v) <> "" Then
        If MsgBox("File already exists - do you wish to overwrite it?", vbYesNo, "File Exists") = vbNo Then Exit Sub
    End If

    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=v, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=False
    End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add v
        .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Answer 1

Try the following

Option Explicit
Private Sub CommandButton1_Click()

    Dim msg As String
        msg = "Would you like to save this file as pdf?"

    If MsgBox(msg, vbYesNo) = vbYes Then

        Dim v As Variant
            v = Application.GetSaveAsFilename(Range("A4").Value, _
                                        "PDF Files (*.pdf), *.pdf")

        If Dir(v) <> "" Then
            If MsgBox("File already exists - do you wish to overwrite it?", _
                              vbYesNo, "File Exists") = vbNo Then 'Exit Sub
            End If
        End If

        With ActiveSheet
            .ExportAsFixedFormat Type:=xlTypePDF, fileName:=v, _
             Quality:=xlQualityStandard, IncludeDocProperties:=True, _
             IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=False
        End With
    Else
        ActiveWorkbook.Save
        v = ActiveWorkbook.path & "\" & ActiveWorkbook.Name
    End If

    Dim OutApp As Object
    Set OutApp = CreateObject("Outlook.Application")
    Dim OutMail As Object
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add v
        .Display
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub