Question

我想在计算机锁定时从Excel工作表发送带有范围的Outlook电子邮件

我正在运行一个使用ODBC连接每周刷新的仪表板。我写了一个在auto_open上运行的宏。该文件由任务计划程序打开。

系统： Windows 7 SP1，展望2016， Excel 2016

问题：当我使用设置将任务计划为“运行”是否用户已登录时，Excel文件将打开并刷新，但它不会发送邮件，也不会显示在我的发件箱中。刷新确实成功发生了。 ~~这是用户未登录的时间。~~我的意思是计算机已被锁定。

当用户登录时，任务计划正常工作

我试过这个Excel VBA - Email Does not Send When Computer is Locked并且它对我不起作用。

我用来发送邮件的功能是：

Dim oApp As Object, OutApp As Object, OutMail As Object
Dim rng As Range
Dim strbody As String, strtail As String

strbody = "Hi team," & "<br>" & _
         "<a href=""https://example.com"">Here</a> is the link to cloud upload" & Worksheets("Core View").Range("M2") & "<br><br>"
strtail = "Thanks," & "<br>" & _
"Team." & "<br><br>"

On Error Resume Next
'Only the visible cells in the selection
'Set rng = Selection.SpecialCells(xlCellTypeVisible)
Set rng = Sheets("Core View").Range("A7:K106").SpecialCells(xlCellTypeVisible)
On Error GoTo 0


If rng Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected. " & _
      vbNewLine & "Please correct and try again.", vbOKOnly
End If

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With


'Create the mail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = "plaknas@example.com"
    .CC = ""
    .BCC = ""
    If EmptySheets <> "" Then
        .Subject = "update has issues in " & EmptySheets
    Else
        .Subject = "Update for week" & Worksheets("Core View").Range("M2")
    End If
    .HTMLBody = strbody & RangetoHTML(rng) & strtail
    .Send   'or use .Display
End With
On Error GoTo 0
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Function

Answer 1

您无法在从任务计划程序或Windows服务运行的脚本或程序中使用Outlook对象模型。安全上下文完全不同，代码不会按预期运行：

https://support.microsoft.com/en-us/kb/237913

在计算机锁定时发送Outlook电子邮件

1 个答案: