Access 2013 - 自动发送电子邮件与Outlook和Windows任务计划程序

Question

我有一个访问宏，运行一组Netezza查询并将结果上传到数据库。然后打开并刷新一个利用这些数据并将文件保存在几个位置的Excel文件。最后，它会编写一个自动发送的电子邮件并将其发送到通讯组列表。当我手动运行宏时，一切都完美无缺。

为了让自己的生活更轻松一点，我使用Windows Task Scheduler（Windows 10）每天自动启动一次宏，这就是我的问题所在。任务计划程序关闭宏，关闭所有查询，保存Excel文件，但不发送电子邮件。

下面是我使用

Sub sendOutlookEmail() 

Dim oApp As Outlook.Application 
Dim oMail As MailItem 
Dim SpDate As String 
Dim Signature As String 
Dim StrPath As String 
Dim StrFilter As String 
Dim StrFile As String 

SpDate = Format(Now() - 1, "yyyy-mm-dd") 


Set oApp = CreateObject("Outlook.application") 

Set oMail = oApp.CreateItem(olMailItem) 
With oMail 
    .Display 
End With 

    Signature = oMail.HTMLBody 

With oMail 

    .SentOnBehalfOfName = "My Email" 
    .To = "CCO Reporting" 
    .Subject = "AHT - ACW Dashboard - " & SpDate 
    .HTMLBody = "<span LANG=EN>" _ 
       & "<font FACE=SegoeUI SIZE = 3>" _ 
       & "The IB/OB AHT - ACW reports have been updated and placed in the following folder:" _ 
       & "<br><br>" _ 
       & "<a href='File Location'>File Location</a>" & "<br><br><br></font></span>" _ 
       & Signature 
    '.Attachments.Add (StrPath & StrFile) 
    '.Display 
    .Send 

End With 

On Error GoTo 0 

Set oMail = Nothing 
Set oApp = Nothing 
End Sub 

下面的代码SendOutlookEmail代码的任务调度设置 Task Scheduler

Answer 1

展望可能只是没有足够的时间来发送消息，因为它在邮件移动到发件箱后立即关闭（.send根据我所知不会发送邮件，但只是将其移动到发件箱并触发发送所有邮件）。

尝试手动添加发送/接收，使访问等待Outlook以实际发送邮件（在Set oApp = Nothing之前添加到您的VBA）：

' Synchronizes (ie sends/receives) OL folders. 
' Ref: http://msdn.microsoft.com/en-us/library/ff863925.aspx 

Dim objNsp As Outlook.NameSpace 
Dim colSyc As Outlook.SyncObjects 
Dim objSyc As Outlook.SyncObject 
Dim i As Integer 

On Error GoTo SyncOL_Err 



Set objNsp = oApp.Application.GetNamespace("MAPI") 
Set colSyc = objNsp.SyncObjects 

For i = 1 To colSyc.Count 
    Set objSyc = colSyc.Item(i)  
    Debug.Print objSyc.Name 
    objSyc.start 
Next 



Set objNsp = Nothing: Set colSyc = Nothing: Set objSyc = Nothing