用於將活動 Excel 文件以 pdf 或 Excel 形式通過電子郵件發送的 VBA 代碼

Question

我有一個命令按鈕的代碼，用於將活動的 Excel 文件保存為 pdf，然后在 Outlook 中打開它供用戶作為電子郵件發送。

但是，這要求用戶在 Outlook 中打開文件之前將文件另存為 pdf。 如果用戶想將副本保存到他們的文件中，它可以完美地工作。

如果用戶想使用提交按鈕但不想保存副本並取消該過程怎么辦？ 使用我下面的代碼，它只是失敗了。

是否可以對其進行編碼，以便如果用戶決定他們不想保存副本，它將默認發送附有活動 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