Question

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

为了让我的生活更轻松，我使用Windows任务计划程序（Windows 10）每天自动触发一次宏，这就是我的问题所在。任务计划程序毫不费力地关闭宏，刷新所有查询，保存excel文件，但不发送电子邮件。

以下是我正在使用的代码SendOutlookEmail代码

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

这是任务调度程序设置 Task Scheduler

Answer 1

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

尝试手动添加发送/接收，以使Access等待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

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

1 个答案: