Outlook 电子邮件性能使用 Excel VBA 时速度缓慢

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:UsersUserDocumentsAssociationEvent BrochureBROCHURE.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列中的公司，最后是单元格I2中的邮件正文，其中包含要为每个收件人替换的关键字。

现在关于资源分配。在任务管理器中，我同时赋予了excel.exe和Outlook.exe很高的优先级。

我的代码运行是否很糟糕，因为我在使用调用 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:UsersUserDocumentsAssociationEvent BrochureBROCHURE.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