通过for循环发送电子邮件的有效期限提醒时出错

时间:2016-02-01 16:52:55

标签: excel vba excel-vba email outlook

我有一张有效期限+承包商名称的表格。

我正在尝试发送电子邮件,只要有效期限在90天和60天内到期。

它发送满足条件的第一个单元格,但之后它向我显示omail.to或omail.subject和omail.send错误,说“该项目已被移动或删除”。

这是代码:

Sub reminderautomail()      

' reminderautomail Macro      
Dim mydate1 As Long      
Dim datetoday1 As Date      
Dim datetoday2 As Long          
Dim x As Long         
Dim aax As String      

Dim olApp As Outlook.Application      
Set olApp = CreateObject("outlook.application")        
Dim olmail As Outlook.MailItem      
Set olmail = olApp.CreateItem(olMailItem)        

For x = 4 To 29    
    aax = Cells(x, 3)    
    mydate1 = Cells(x, 9)    

    datetoday1 = Date     
    datetoday2 = datetoday1         
    expi = (mydate1 - datetoday2)        

    If expi <= 90 And expi >= 60 Then    
        Cells(x, 10) = "YES"    
        Cells(x, 11) = expi    

        olmail.To = "email address"    
        olmail.Subject = " An Agreement is about to expire soon "    
        olmail.Body = " This agreement is about to expire in " & Cells(x, 11) & " days from today's date" & " the agreement is for " & aax    
        'olmail.Display    
        olmail.Send    

    ElseIf expi <= 60 And expi > 0 Then    
        Cells(x, 10) = "YES"    
        Cells(x, 11) = expi    
        olmail.To = "email address"    
        olmail.Subject = " An Agreement is about to expire soon "        
        olmail.Body = " This agreement is about to expire in " & Cells(x, 11) & " days from today's date" & " the agreement is for " & aax        
        'olmail.Display        
        olmail.Send         

    ElseIf Cells(x, 10) < 0 Then        
        Cells(x, 11) = "Expired !!"      
    End If     

Next     
Set olApp = Nothing     
Set olmail = Nothing     

End Sub 

Here is the error
在这里,上一次迭代中的代码向我发送了一个没有错误的电子邮件提醒,但是当它进入下一次迭代时,它会显示此错误。

1 个答案:

答案 0 :(得分:0)

在第一次成功迭代发送并发送电子邮件后,对象olMail将丢失。

&#34;该项目已被移动或删除&#34;很可能是你收到的错误。

为防止这种情况发生,请确保每次符合条件时都创建一个新的电子邮件对象,如下所示:

If expi <= 90 And expi >= 60 Then    
    Set olmail = olApp.CreateItem(olMailItem)   

    'Do your things

    olmail.Send
ElseIf expi <= 60 And expi > 0 Then
    Set olmail = olApp.CreateItem(olMailItem) 

    'Do your things

    olmail.Send  
ElseIf Cells(x, 10) < 0 Then        
    Cells(x, 11) = "Expired !!"      
End If