Question

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

此外，我的CPU利用率为15-20％，而16G内存利用率为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列中的Mr / Mrs，D列中的company以及I2单元中的邮件正文，可以为每个收件人替换关键字。

现在有关资源分配。在任务管理器中，我给excel.exe和Outlook.exe都赋予了较高的优先级。

我使用Call SendMail时调用另一个函数，代码是否运行不正常？

我使用DoEvent导致代码运行不正常吗？这是我知道的唯一方法...因此，如果您建议使用与DoEvent不同的方法，请解释它的作用。

Answer 1

在这里我可以快速重写：

将所有代码放入一个例程中。我们创建一次Outlook应用程序，然后从一个实例发送多次
切换到一个For Each循环，这更简洁
已将DoEvents删除为注释。 IF ，您绝对需要在运行时中断代码执行，然后将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

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

1 个答案: