[英]Outlook email performance slow using Excel VBA
Outlook sends emails really slowly. Outlook 发送电子邮件的速度非常慢。
Moreover my CPU is at 15-20% and my 16G ram is at 50% utilization...so this could be either an issue of code performance or of resource allocation.此外,我的 CPU 为 15-20%,而我的 16G ram 的利用率为 50%……所以这可能是代码性能或资源分配的问题。
I have included my code below:我在下面包含了我的代码:
'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
This code is two macros I created in Excel sheet which contains the email addresses in Column A, Names in Column B, Mr/Mrs in Column C, the company in Column D, and finally the message body in cell I2, which has key words to be replaced for each recipient.这段代码是我在 Excel 表格中创建的两个宏,其中包含 A 列中的电子邮件地址、B 列中的姓名、C 列中的先生/夫人、D 列中的公司,最后是单元格 I2 中的消息正文,其中包含关键字为每个收件人更换。
Now regarding the resource allocation.现在关于资源分配。 In task manager I gave both excel.exe and Outlook.exe a high priority.
在任务管理器中,我给 excel.exe 和 Outlook.exe 一个高优先级。
Is my code running badly because I call another function when I use Call SendMail?我的代码运行很糟糕是因为我在使用 Call SendMail 时调用了另一个函数吗?
Is my code running badly because I use DoEvent?因为我使用了 DoEvent,所以我的代码运行很糟糕吗? That is the only method I know...so if you suggest a different one than DoEvent please explain what it does.
这是我知道的唯一方法……所以如果你建议一个与 DoEvent 不同的方法,请解释它的作用。
Here's a quick rewrite where I've:这是我快速重写的地方:
DoEvents
into a comment.DoEvents
删除到注释中。 IF you absolute need to be able to break code execution while it's running then you'll want to keep DoEvents
in your loop.DoEvents
保留在循环中。 If you don't care though and just want the thing to run as fast as possible, then leave it out.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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.