码转发邮件慢

我发送电子邮件到联系人的大名单。我不想丢失原始电子邮件的格式。码转发邮件慢

我使用这个代码：

Dim emailad, firstname, pretit, midtit, prebod, bod, postbod As String 
Dim n As Integer 
n = 1 

pretit = Sheets(CurrSh).Range("pretit").Value 
midtit = Sheets(CurrSh).Range("midtit").Value 
prebod = Sheets(CurrSh).Range("prebod").Value 
bod = Sheets(CurrSh).Range("bod").Value 
postbod = Sheets(CurrSh).Range("postbod").Value 

Dim objMail(1 To 500) As Object 
Set objitem = GetCurrentItem() 

'********** Send e-mail for each e-mail in the list *********** 
Set objMail(n) = CreateObject("Outlook.Application") 

While (Sheets(CurrSh).Range("emailad_ini").Offset(n, 0).Value <> "") 
    emailad = Sheets(CurrSh).Range("emailad_ini").Offset(n, 0).Value 
    firstname = Sheets(CurrSh).Range("firstname_ini").Offset(n, 0).Value 


    Set objMail(n) = objitem.Forward 

    objMail(n).To = emailad 
    objMail(n).Subject = pretit & " " & firstname & midtit & " FWD: " & objitem.Subject 
    objMail(n).HtmlBody = "<HTML><BODY><FONT FACE='Arial'><FONT SIZE='2'>" & prebod & " " & firstname & "," & "<br>" & bod & "<br>" & postbod & objMail(n).HtmlBody & "</FONT></FONT></BODY></HTML>" 
    objMail(n).Display 
    Set objMail(n) = Nothing 
    n = n + 1 
Wend 

Theend: 
End Sub

问题是这样的代码是如此之慢。

来源

2017-02-20 Vinicius

在这个循环中表现不佳最强的犯罪嫌疑人是循环的每个迭代一个新的Outlook.Application对象的创建。这不应该是必要的。将Set ObjApp = CreateObject("Outlook.Application")调用移到WHILE循环之前，并简单地重新使用其中的相同引用。

修订OP基础上，进一步的评论：

我要简化该代码以匹配我认为你想完成的任务。我认为不需要大量的邮件对象，因为您在显示后将它们设置为Nothing。看起来你想要做的就是拿出当前的项目并将它发送给你的列表中的每个成员，并用他们自己的名字作为主题进行定制。在这方面，我想试试这个：

Dim emailad, firstname, pretit, midtit, prebod, bod, postbod As String 
Dim mailApp 
Dim newItem 
Dim n As Integer 
n = 1 

pretit = Sheets(CurrSh).Range("pretit").Value 
midtit = Sheets(CurrSh).Range("midtit").Value 
prebod = Sheets(CurrSh).Range("prebod").Value 
bod = Sheets(CurrSh).Range("bod").Value 
postbod = Sheets(CurrSh).Range("postbod").Value 

Set objitem = GetCurrentItem() 
Set mailApp = CreateObject("Outlook.Application") 

'********** Send e-mail for each e-mail in the list *********** 

While (Sheets(CurrSh).Range("emailad_ini").Offset(n, 0).Value <> "") 

    emailad = Sheets(CurrSh).Range("emailad_ini").Offset(n, 0).Value 
    firstname = Sheets(CurrSh).Range("firstname_ini").Offset(n, 0).Value 

    Set newItem = mailApp.CreateItem(0) ' Create a new Mailitem; olMailItem = 0 

    newItem.To = emailad 
    newItem.Subject = pretit & " " & firstname & midtit & " FWD: " & objitem.Subject 
    newItem.HtmlBody = "<HTML><BODY><FONT FACE='Arial'><FONT SIZE='2'>" & prebod & " " & firstname & "," & "<br>" & bod & "<br>" & postbod & objItem.HtmlBody & "</FONT></FONT></BODY></HTML>" 

    newItem.Send 
    n = n + 1 

Wend

除此之外，什么部分（特别是）慢？发送此邮件的60个副本不应该花费那么长时间。你确定你的循环在你期望的时候会终止吗（只有60个名字），或者你的工作表中的数据是否可能阻止你的终止发生在你想要的时候，导致它无限期地运行？

来源

2017-02-20 22:01:28

我试了一下，但代码仍然性能差我认为这是因为电子邮件，我正在做的转发，是与HTML中的文本。所以，这个代码可能很慢你有任何其他的想法吗？感谢帮助 – Vinicius

我有60个客户名单，它是如此难以运行这段代码 – Vinicius

，我想使用在如表的格式TEX。 – Vinicius

码转发邮件慢

回答

相关问题