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

通过电子邮件将Excel Excel文件作为pdf或Excel发送的VBA代码

1 个答案: