は、私がコード持っているループ

Question

の自動メールを送信：

をアイテムが移動または削除されました：それは最初の電子メールを送信し

Sub sendEmail() 
    Dim OutlookApp As Object 
    Dim OutlookItem As Object 
    Dim i As Integer 
    Dim Address As String 

    Set OutlookApp = CreateObject("Outlook.Application") 
    Set OutlookItem = OutlookApp.CreateItem(0) 

    With OutlookItem 
    For i = 4 To 15 
     If Cells(i, 18) <= Cells(i, 6) Then 
     Address = Cells(i, 14).Value 
     Set OutlookApp = CreateObject("Outlook.application") 
     Set OutlookItem = OutlookApp.CreateItem(0) 

     .To = Address 
     .Subject = "Calibration Due Soon !!!" 
     .Body = "Reminder: Calibration of " & Cells(i, 4) & "is due on " & Cells(i, 9) 
     .Send 

     Set OutlookItem = Nothing 
     Set OutlookApp = Nothing 

     'Application.Wait (Now + #12:00:08 AM#) 
     ElseIf Cells(i, 18) > Cells(i, 15) Then 
     Exit Sub 
     ElseIf Cells(i, 18) = "" And Cells(i, 15) = "" Then 
     Exit Sub 
     End If 
    Next i 
    End With 
End Sub 

を、それは言って実行時エラーを私に求められます

デバッガでは、 ".To = Address"行が強調表示されます。 送信の代わりに.Displayを使用すると動作します。 アイデア

Answer 1

すべてのループ反復でOutlookアプリケーションオブジェクトを再作成することは意味がありません。 Outlookを強制終了し、送信するすべてのメールに対してOutlookを再起動するのと同じです。それはしません。

まず、Excel VBAプロジェクト（またはインストールしたバージョン）の「Microsoft Outlook 15.0 Object Library」への参照を設定します。

Newで直接Outlookオブジェクトを作成することができます。また、オートコンプリートとすべてのOutlook固有の定数（olMailItemなど）を有効にすることができます。

今、あなたのコードはこのような何かに凝縮することができます：あなたがループ*内側* NothingにOutlookのアプリを設定しますなぜ

Sub sendEmail() 
    Dim OutlookApp As New Outlook.Application 
    Dim r As Range 

    For Each r In ActiveSheet.Range("4:15").Rows 
    If r.Cells(18) <= r.Cells(6) And r.Cells(18) > "" And r.Cells(15) > "" Then 
     With OutlookApp.CreateItem(olMailItem) 
     .To = r.Cells(14) 
     .Subject = "Calibration Due Soon !!!" 
     .Body = "Reminder: Calibration of " & r.Cells(4) & " is due on " & r.Cells(9) 
     .Send 
     End With 
    End If 
    Next r 

    OutlookApp.Quit 
    Set OutlookApp = Nothing 
End Sub