使用 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