電子メールを転送するコードが遅い

連絡先の大きなリストに電子メールを送信します。私は元の電子メールのフォーマットを失いたくはありません。電子メールを転送するコードが遅い

私はこのコードを使用しています：

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

私が使用しようとしているテックスはシートのようなフォーマットです。 – Vinicius

電子メールを転送するコードが遅い

答えて

関連する問題