将 excel pdf 发送到邮件时无法关闭 windows

Question

所以我找到了一个将 excel sheet 导出为 pdf 的宏，将该 pdf 发送到带有 outlook 的电子邮件地址，然后关闭 outlook（如果由宏打开）并删除 pdf 文件.

我找到了我附在右下方的代码 here

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object

  ' Not sure for what the Title is
  Title = "DUTY"

  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & ".pdf"

  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)

    ' Prepare e-mail
    .Subject = Title
    .To = "info@feam.be" ' <-- Put email of the recipient here
    .Body = "Zie bijlage voor de duty report"
    .Attachments.Add PdfFile

    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0

  End With

  ' Delete PDF file
  Kill PdfFile

  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit

  ' Release the memory of object variable
  Set OutlApp = Nothing

它就像一个魅力，除了完成后，有两个 Excel windows 打开（不是 sheets，只是没有任何 [=28= 的应用程序] 在其中打开），我似乎无法关闭。

我尝试通过添加

来修复它

ActiveWorkbook.Close True

Application.Quit

...在代码末尾，但这似乎并不能解决问题。有没有人有这方面的经验，希望知道如何解决这个问题？

Answer 1

我测试了你的代码，没有发现错误。但是，我发现不需要您的各种调用来使应用程序可见。因此我省略了它们。也许他们是你经历的原因。下面是我测试的代码。

Sub SendPDF()

    Dim OutApp As Object
    Dim IsCreated As Boolean
    Dim PdfFile As String, Fn() As String
    Dim Title As String

'    ' Define PDF filename
    Fn = Split(ActiveWorkbook.FullName, ".")
    Fn(UBound(Fn)) = "pdf"
    PdfFile = Join(Fn, ".")

    ' this code will not work if the file name includes a period:-
'    PdfFile = ActiveWorkbook.FullName
'    i = InStrRev(PdfFile, ".")
'    If i > 1 Then PdfFile = Left(PdfFile, i - 1)
'    PdfFile = PdfFile & ".pdf"

    ' Export activesheet as PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=PdfFile, _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False

    ' Use already open Outlook if possible
    On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    If Err Then
        Set OutApp = CreateObject("Outlook.Application")
        IsCreated = True
    End If
'    OutApp.Visible = True             ' you don't need this to be visible
                                       ' unless you want to edit before sending
    On Error GoTo 0

    ' This is the tile of the email
    Title = "Duty report " & Date

    ' Prepare e-mail with PDF attachment
    With OutApp.CreateItem(0)
        .Subject = Title
        .To = "info@feam.be" ' <-- Put email of the recipient here
        .Body = "Zie bijlage voor de duty report"
        .Attachments.Add PdfFile

        On Error Resume Next
        .Send                           ' try to send

    '    Application.Visible = True     ' appears not required

        If Err Then
            Title = "An error occurred." & vbCr & _
                    "The email wasn't sent."
        Else
            Title = "The mail was prepared successfuly." & vbCr & _
                    "It is now in your outbox."
        End If
        MsgBox Title, vbInformation, "Execution report"
    End With
    On Error GoTo 0

    ' Delete PDF file
    Kill PdfFile

    ' Quit Outlook if it was created by this code
    If IsCreated Then OutApp.Quit

    ' Release the memory of OutApp object variable
    Set OutApp = Nothing
End Sub

您会发现我做了一些更改，包括在主题中添加日期 ("Title")，这是建议的性质，因为您不知道它的用途。请阅读我添加到代码中的注释。

令我惊讶的是，我无法使您打开 Outlook 的方法起作用。每次我没有打开 Outlook 时，我的代码都会失败。我提到了 Ron de Bruin，发现你的代码没有问题。最后我保留原样。在我的测试中，当 Outlook 不是运行时，无法设置对象 OutApp 并导致通知 "Outlook is trying to recover your information"，然后下一次引用 OutApp 失败。如果此功能对您很重要，则可能值得单独提问。否则，我建议修改代码以在 Outlook 不是运行时发出消息，而不是尝试创建对象。仅供参考，我用 Excel 2010 进行了测试。

将 excel pdf 发送到邮件时无法关闭 windows

unclosable windows when sending excel pdf to mail

pdf

email

excel

vba

window