如何在outlookclosures时发送邮件

我有以下几行代码。 当Outlook打开时,它工作正常,但我希望它能够工作,即使Outlook已closures。 我保持代码在命令button单击事件。

Private Sub btnSend_Click() Dim OutApp As Object Dim OutMail As Object Set OutApp = GetObject("", Outlook.Application) OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = "adbc@adbc.com" .CC = "" .BCC = "" .Subject = "Test mail from Excel Sheet-OutLook Closed" .Body = "This is body of the mail" .Display .Send .ReadReceiptRequested = True End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Sub 

我用GetObject和CreateObject方法试了一下。 如果我closuresOutlook后执行此代码,它不显示任何错误,但它不发送任何邮件。

以下几行代码发送邮件,但他们排队在Outlook的发件箱中。 当用户打开Outlook时,只有他们正在从发件箱中移出。

 Private Sub btnSend_Click() Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = "adbc@adbc.com" .CC = "" .BCC = "" .Subject = "Test mail from Excel Sheet-OutLook Closed" .Body = "This is body of the mail" .Display .Send .ReadReceiptRequested = True End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Sub 

您可以使用shell命令在发送邮件之前实际打开Outlook

 Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Public Sub OpenOutlook() Dim ret As Long On Error GoTo aa ret = ShellExecute(Application.hwnd, vbNullString, "Outlook", vbNullString, "C:\", SW_SHOWNORMAL) If ret < 3 Then MsgBox "Outlook is not found.", vbCritical, "SN's Customised Solutions" End If aa: End Sub 

保持在一个单独的模块,并从你正在发送邮件的代码调用模块。我正在努力的部分是如何隐藏这个,使激活仍然与Excel

对于Outlook 2013,这是Outlook设置的问题,而不是VBA代码。

  • 打开OUTLOOK

  • 转到文件 – >选项 – >高级

  • 滚动到“发送和接收”标题,然后单击“发送/接收…”button

  • 在“为组设置所有帐户”下,确保“在退出时执行自动发送/接收”处于选中状态

这可以确保OUTLOOK“发件箱”中的所有项目都在Outlookclosures时发送。 这为我解决了这个问题。 对于其他版本的Outlook可能类似。