时间戳

首页 > 解决方案 > 使用 Excel VBA 发送电子邮件

excel - 使用 Excel VBA 发送电子邮件

问题描述

我有一个宏（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 错误：

VBScript 错误

标签： excelvbavbscript

解决方案

您可以跳过 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

不是最后的错误。

推荐阅读