用于将活动 Excel 文件发送为 pdf 或 Excel 的 VBA 代码

Question

我有一个命令按钮的代码，用于将活动的 Excel 文件保存为 pdf，然后在 Outlook 中将其打开以供用户作为电子邮件发送。

但是，这需要用户先将文件保存为 pdf，然后才能在 Outlook 中打开它。如果用户想要将副本保存到他们的文件中，它可以完美地工作。

如果用户想要使用提交按钮但不想保存副本并取消该过程怎么办？使用我下面的代码，它只是失败了。

是否可以对其进行编码，以便如果用户决定他们不想保存副本，则默认情况下会发送一封附有活动 Excel 文件的电子邮件？

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

试试下面的

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