使用 Excel VBA 降低 Outlook 电子邮件性能

Question

Outlook 发送电子邮件的速度非常慢。

此外，我的 CPU 为 15-20%，而我的 16G ram 的利用率为 50%……所以这可能是代码性能或资源分配的问题。

我在下面包含了我的代码：

 'my code
    Sub SendMail(what_address As String, subject_line As String, mail_body As String)

    Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")

        Dim olMail As Outlook.MailItem
        Set olMail = olApp.CreateItem(olMailItem)

        With olMail
            .To = what_address
            .Subject = subject_line
            .BodyFormat = olFormatHTML
            .Attachments.Add "C:\Users\User\Documents\Association\Event Brochure\BROCHURE.pdf"
            .HTMLBody = mail_body
            .Send
        End With

    End Sub 'Tells outlook to send an input, with an attachment I selected


    Sub SendMassMail()

    row_number = 1

    Do
    DoEvents
        row_number = row_number + 1
        Dim mail_body_message As String
        Dim name As String
        Dim mrmrs As String
        Dim company_name As String

        mail_body_message = Sheet1.Range("I2")
        name = Sheet1.Range("B" & row_number)
        mrmrs = Sheet1.Range("C" & row_number)
        company_name = Sheet1.Range("D" & row_number)

        mail_body_message = Replace(mail_body_message, "replace_mrmrs_here", mrmrs)
        mail_body_message = Replace(mail_body_message, "replace_name_here", name)
        mail_body_message = Replace(mail_body_message, "replace_company_here", company_name)


        Call SendMail(Sheet1.Range("A" & row_number), "Event Sponsorship", mail_body_message)

    Loop Until row_number = 500

    End Sub

这段代码是我在 Excel 表格中创建的两个宏，其中包含 A 列中的电子邮件地址、B 列中的姓名、C 列中的先生/夫人、D 列中的公司，最后是单元格 I2 中的消息正文，其中包含关键字为每个收件人更换。

现在关于资源分配。 在任务管理器中，我给 excel.exe 和 Outlook.exe 一个高优先级。

我的代码运行很糟糕是因为我在使用 Call SendMail 时调用了另一个函数吗？

因为我使用了 DoEvent，所以我的代码运行很糟糕吗？ 这是我知道的唯一方法……所以如果你建议一个与 DoEvent 不同的方法，请解释它的作用。

Answer 1

这是我快速重写的地方：

1. 将所有代码放在一个例程中。 我们创建 Outlook 应用程序一次并从一个实例发送多次
2. 切换到一个更干净的 For Each 循环
3. 将DoEvents删除到注释中。 如果您绝对需要能够在运行时中断代码执行，那么您将希望将DoEvents保留在循环中。 如果你不在乎，只是想让它运行得尽可能快，那就把它放在一边。 我建议（正如@JoshEller 指出的那样）首先将这些电子邮件保存为草稿可能是更好的选择。 然后，您可以从 Outlook 手动发送，以发现在为时已晚（令人尴尬）之前可能已犯的任何错误。

Sub SendMassMail()  
    'Create your outlook object once:
    Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")

    'Declare your mail object
    Dim olMail As Outlook.MailItem

    'Some variables used in the loop. Declare outside:
    Dim mail_body_message As String
    Dim name As String
    Dim mrmrs As String
    Dim company_name As String

    'Do your loop. Using a for loop here so we don't need a counter
    Dim rngRow as Range
    For each rngRow in Sheet1.Range("B2:B500").Rows
        'No reason to do this here
        'DoEvents

        mail_body_message = Sheet1.Range("I2")
        name = rngRow.Cells(1, 2).value 'Column B
        mrmrs = rngRow.Cells(1, 3).Value 'Column C
        company_name = rngRow.Cells(1, 4).value 'Column D

        mail_body_message = Replace(mail_body_message, "replace_mrmrs_here", mrmrs)
        mail_body_message = Replace(mail_body_message, "replace_name_here", name)
        mail_body_message = Replace(mail_body_message, "replace_company_here", company_name)

        'Generate the email and send
        Set olMail = olApp.CreateItem(olMailItem)

        With olMail
            .To = rngRow.Cells(1,1).value 'Column A
            .Subject = "M&A Forum Event Sponseorship"
            .BodyFormat = olFormatHTML
            .Attachments.Add "C:\Users\User\Documents\Association\Event Brochure\BROCHURE.pdf"
            .HTMLBody = mail_body_message
            .Send

            'Instead of .send, consider using:
            '.Save
            '.Close
            'Then you'll have it as a draft and you can send from outlook directly
        End With        

    Next rngRow

    'Destroy the outlook application
    Set olApp = Nothing

End Sub