Question

我有一个宏（通过任务scehduler用VBScript执行），它会进行一些计算，然后发送一封带有工作簿的电子邮件。我面临的问题是使用VBSCript执行宏时，电子邮件未发送，在以下行出现ActiveX component can't create object: 'Outlook.Application'错误：Set OutApp = CreateObject("Outlook.Application")，但是电子邮件当使用播放按钮手动运行宏时发送。

宏可以在笔记本电脑上与Office 2013一起正常工作，但是我正在Office 2016上在另一个桌面上运行它，并在excel中启用了以下引用：Microsoft Outlook 16.0 Object Library，但尚未修好它。

可能导致此行为的原因是什么？我注意到的一件事是启动outlook 2016时弹出以下错误消息：The server you are connected to is using a security certificate that cannot be verified。我也得到了VBScript runtime error，但是我不确定这是原因。

VBSCript运行宏：

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Reports\Daily Traffic Report per Site\Report.xlsm", , True)   'true here means readonly=yes.


objExcel.Application.Run "Report.xlsm!Email_Workbook"
objExcel.ActiveWorkbook.Close

WScript.Quit

宏发送电子邮件：

Sub Email_Workbook()
'Mail a copy of the ActiveWorkbook with another file name
    Dim wb1 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object

    Set wb1 = Workbooks("Traffic Report.xlsx")

    'Make a copy of the file/Open it/Mail it/Delete it
    'If you want to change the file name then change only TempFileName
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Daily Traffic Report" & " " & Format(Now, "dd-mmm-yyyy")
    FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
         .to = "xxx"
        .BCC = ""
        .Subject = "DIALY TRAFFIC REPORT"
        .Body = "Please find attached the Daily Traffic Report."
        .Attachments.Add TempFilePath & TempFileName & FileExtStr
        .Send
    End With
    On Error GoTo 0

    'Delete the file
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

VBScript错误：

Answer 1

您可以跳过VBscript和Task脚本，而使用VBA Application.OnTime。
此函数将尽早运行宏（了解该函数的含义）。
如果工作簿已关闭，它将打开工作簿以运行宏。

Public fireTime As Date

Private Sub Workbook_Open()
    if fireTime = "00:00:00" then ' if the code has not been run before
        fireTime = TimeValue("09:00:00")
        Application.OnTime EarliestTime:=fireTime, Procedure:="Email_Workbook", Schedule:=True
        Application.displayAlerts = False
        ThisWorkbook.close
    end if
End Sub

以上内容将在每天早上9点开始自动运行，然后关闭工作簿。时间为9时，工作簿将打开并运行Email_Workbook。

在Email_Workbook的结尾，我认为您需要添加：

fireTime = TimeValue("09:00:00")
Application.OnTime EarliestTime:=fireTime, Procedure:="Email_Workbook", Schedule:=True

为确保第二天9点再次运行。
现在，您可以在Windows启动中添加指向该文件的链接，以便每次启动计算机时，都会打开该文件，将下一个运行时间设置为9，然后关闭自身。
在9点，它运行Email_Workbook并将下一次运行设置在第二天的9点。

要使其停止运行，您需要重新启动计算机或使用以下命令：

Application.OnTime EarliestTime:=fireTime, Procedure:="Email_Workbook", Schedule:=False

最后不是假的。

使用Excel VBA发送电子邮件

1 个答案: