使用 Excel VBA 发送电子邮件

Question

I have a macro (executed with a VBScript via task scehduler) that does some calculations then sends an email with a workbook attached. The problem that I'm facing is that the email is not sent when the macro is executed with the VBSCript , I get an ActiveX component can't create object: 'Outlook.Application' error on the following line: Set OutApp = CreateObject("Outlook.Application") , but the email is sent when the macro is run manually using the play button.

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.

What might be the reason causing this behavior? One thing that I've noticed is that the following error message pops up when starting outlook 2016 : The server you are connected to is using a security certificate that cannot be verified . Also I get a VBScript runtime error but I'm not sure that is the cause.

VBSCript to run macro:

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

Macro to send 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 Error:

Answer 1

You can skip VBscript and Task scehduler and use VBAs Application.OnTime.
This function will run a macro at a earliest time (read about the function what that means).
If the workbook is closed, it will open the workbook to run the macro.

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

The above will start the autorun each day at 9 each morning, then close the workbook. When the time is 9 the workbook will open and run Email_Workbook.

At the end of Email_Workbook I think you need to add:

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

To make sure it runs again next day at 9.
Now you can add in windows startup a link to this file, so that each time you start the computer, this file opens, sets next run at 9, then closes itself.
At 9 it runs Email_Workbook and sets the next run at 9 next day.

To stop it from running you need to either restart the computer or use the command:

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

Not the False at the end.