使用 Excel VBA 發送電子郵件

Question

我有一個宏（通過任務調度程序使用VBScript執行）進行一些計算，然后發送一個帶有工作簿的 email。 我面臨的問題是，當使用 VBSCript 執行宏時未發送VBSCript ，我得到一個ActiveX component can't create object: 'Outlook.Application' Set OutApp = CreateObject("Outlook.Application") ，但是當使用播放按鈕手動運行宏時會發送 email。

The macro works fine with Office 2013 on my laptop but I'm running it on a different desktop with Office 2016 and have enabled the following reference in excel: Microsoft Outlook 16.0 Object Library but that hasn't fixed it.

導致這種行為的原因可能是什么？ 我注意到的一件事是在啟動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

宏發送email：

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 和任務調度器並使用 VBA 應用程序.OnTime。
這個 function 將在最早的時間運行一個宏（閱讀 function 這意味着什么）。
如果工作簿已關閉，它將打開工作簿以運行宏。

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

不是最后的錯誤。