エクセルシートの特定のフィールドを使用してOutlookで電子メールを自動化するExcel

Question

私の職場で効率を改善するために取り組んでいます。このために、人々のリストに電子メールを送信する作業があります。

このため、次のコードを作成しました。これが改善できるかどうか知りたいですか？このコードは、ブックにシート「Final_list」からの情報を受け取り、ヘッダは1

Sub EmailToAll() 

    Dim outlookApp As Outlook.Application 
    Dim outlookMail As Outlook.MailItem 

    Set outlookApp = CreateObject("Outlook.Application") 
    Set outlookMail = outlookApp.CreateItem(olMailItem) 



    Dim sh As Worksheet 
    Dim RowCount As Integer 

    Worksheets("Final_List").Activate 

    RowCount = 2 

    Set sh = ActiveSheet 

    Do While IsEmpty(sh.Cells(RowCount, 1).Value) = False 

     Set outlookApp = CreateObject("Outlook.Application") 
     Set outlookMail = outlookApp.CreateItem(olMailItem) 
     With outlookMail 
       'MsgBox sh.Cells(RowCount, 7).Value 
       .To = sh.Cells(RowCount, 7).Value 
       .CC = sh.Cells(RowCount, 9).Value 
       .BCC = Empty 
       .Subject = "[Update]" & " " & sh.Cells(RowCount, 1).Value & "-" & sh.Cells(RowCount, 8).Value 
       .BodyFormat = 2 
       .HTMLBody = "Hello " 
       '.Display 
       '.Save 
       '.Close 
       .Send 
       'MsgBox "Mail saved for" & sh.Cells(RowCount, 7).Value & "!" 
       RowCount = RowCount + 1 
     End With 

    Loop 

    Set outlookMail = Nothing 
    Set outlookApp = Nothing 
    MsgBox "All mails sent!" 

End Sub 

Answer 1

Outlook Object twiceを作成する必要はありません。 Set outlookApp = CreateObject("Outlook.Application")とDim RowCount As Long

Also avoid.Activate

Option Explicit 
Sub EmailToAll() 
    Dim outlookApp As Outlook.Application 
    Dim outlookMail As Outlook.MailItem 
    Dim RowCount As Long 

    Set outlookApp = CreateObject("Outlook.Application") 

    RowCount = 2 

    With Worksheets("Final_List") 
     Do While IsEmpty(Cells(RowCount, 1).Value) = False 

      Set outlookMail = outlookApp.CreateItem(olMailItem) 
      With outlookMail 
        .To = Cells(RowCount, 7).Value 
        .CC = Cells(RowCount, 9).Value 
        .BCC = Empty 
        .Subject = "[Update]" & " " & Cells(RowCount, 1).Value & "-" & Cells(RowCount, 8).Value 
        .BodyFormat = 2 
        .HTMLBody = "Hello " 
        .Send 
      End With 
      RowCount = RowCount + 1 
     Loop 
    End With 

    Set outlookMail = Nothing 
    Set outlookApp = Nothing 

    MsgBox "All mails sent!" 

End Sub 

に Dim RowCount As Integerを変更

Answer 2

はあなたの例を見て後が、最適化したいと思い、まさにこの部分わからない、ここにカップルの行にあります私が変化を見ているもののうち、

ループ内で変更されるのは受信者と件名だけですが、本文は常に同じです（明らかに私はそれらのセルに格納されているものはわかりません）が、受信者の文字列ループ内でセミコロンで電子メールアドレスを区切り、複数の電子メールではなく1つの電子メールを送信すると正常に動作するはずです。

もう1つ言及したいのは、誰かが間違ってその行を削除した場合、ループがすべての受信者を拾わないことを意味する空白行が発生したときに停止するということです。あなたが使うことができるデータの終わりを見つける多くの堅牢な方法があります。

希望に役立ちます。