将 Excel PDF 发送到邮件时不可关闭的窗口

Question

所以我找到了一个宏，将excel工作表导出为pdf，将该pdf发送到带有outlook的电子邮件地址，然后关闭Outlook(如果由宏打开)并删除pdf文件。

我在这里找到了我附在下面的代码

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 = "[e-mail]" ' <-- 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 窗口(不是工作表，只是没有打开任何工作表的应用程序)，我似乎无法关闭。

我尝试通过添加来修复它

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 = "[e-mail]" ' <-- 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

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

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