電子メール複数の受信者VBAエラー

Question

人のリストに電子メールを送信するためのヘルプを探しています。私のコードには単純なループがあり、電子メールをどこに送信するかの度に値を取得します。テスト中は、最初のメールが常に送信されます。その後、Iによる2回目は、アイテムが移動または削除されました「.TO」

Run-time error - '-2147221238 (8004010a): にエラーが発生します。

コードが正確に次の電子メール値を取得するので、これは困惑していますか？

受信者をbccのリストに追加するのではなく、1通ずつ送信する必要があります。これはVBAで可能ですか？前もって感謝します！

Sub TestingAgain() 

'Setting up the Excel variables. 
Dim outApp As Object 
Dim outMailItem As Object 
Dim iCounter As Integer 
Dim sDest As String 
Dim sName As String 

'Create the Outlook application and the empty email. 
Set outApp = CreateObject("Outlook.Application") 
Set outMailItem = outApp.CreateItem(0) 

With outMailItem 
    sDest = "" 
For i = 2 To WorksheetFunction.CountA(Columns(1)) 
    If i <> "" Then 
     'Grab first name and email 
     sDest = Cells(i, 5).Value 
     sName = Cells(i, 1).Value 

     'Send each email 
     .To = sDest 
     .Subject = "FYI" 
     .htmlbody = "Some stuff" 
     .Send 
    Else 
    MsgBox ("Error") 

    End If 
Next i 

End With 

'Clean up the Outlook application. 
Set outMailItem = Nothing 
Set outApp = Nothing 

End Sub 

Answer 1

電子メールを送信すると、mailItemインスタンスが完了し、もう使用できなくなります。次のようなコードをリファクタリングしてください：

Sub TestingAgain() 

    'Setting up the Excel variables. 
    Dim outApp As Object 
    Dim outMailItem As Object 
    Dim iCounter As Integer 
    Dim sDest As String 
    Dim sName As String 

    'Create the Outlook application and the empty email. 
    Set outApp = CreateObject("Outlook.Application") 



     sDest = "" 
    For i = 2 To WorksheetFunction.CountA(Columns(1)) 
     If i <> "" Then 
     '/ Create the mail item instance. 
     Set outMailItem = outApp.CreateItem(0) 
     With outMailItem 
       'Grab first name and email 
       sDest = Cells(i, 5).Value 
       sName = Cells(i, 1).Value 

       'Send each email 
       .To = sDest 
       .Subject = "FYI" 
       .htmlbody = "Some stuff" 
       .send 
       '/ Once sent, mail item is no more available. 
      End With 
      Else 
      MsgBox ("Error") 

      End If 

    Next 


    'Clean up the Outlook application. 
    Set outMailItem = Nothing 
    Set outApp = Nothing 
End Sub