VBA Run Time Error The Item Has been moved or deleted

**shazi779** · 07-29-2017, 08:54 PM

Can anyone help me please i am trying to send email using excel based on cell dates but after sending email to 1 email address it gives error "Run Time Error Item Has been moved or deleted" And when i reopen the file it sends email to same id that already has been sent the code i am using is below

Private Sub Workbook_Open()

Dim i As Long
Dim OutApp, OutMail As Object
Dim strto, strcc, strbcc, strsub, strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

For i = 3 To Range("J65536").End(xlUp).Row
If Cells(i, 13) <> "Y" Then
If Cells(i, 8) - 7 < Date Then

strto = Cells(i, 10).Value 'email address
strsub = "RA " & Cells(i, 6).Value & " is due on Due date " & Cells(i, 7).Value 'email subject
strbody = "Dear " & Cells(i, 14).Value & vbNewLine & "please update your project status" 'email body

With OutMail
.To = strto
.Subject = strsub
.Body = strbody
.Send

End With

Cells(i, 11) = "EMail Sent " & Now()
Cells(i, 12) = "Y"

End If

End If
Next

Set OutMail = Nothing
Set OutApp = Nothing
ActiveWorkbook.Save

End Sub

**Kaper** · 07-31-2017, 03:08 AM

Try slight modification (not tested):

Private Sub Workbook_Open()

Dim i As Long
Dim OutApp, OutMail As Object
Dim strto, strcc, strbcc, strsub, strbody As String

Set OutApp = CreateObject("Outlook.Application")


For i = 3 To Range("J65536").End(xlUp).Row
  If Cells(i, 13) <> "Y" Then
    If Cells(i, 8) - 7 < Date Then
      Set OutMail = OutApp.CreateItem(0)
      strto = Cells(i, 10).Value 'email address
      strsub = "RA " & Cells(i, 6).Value & " is due on Due date " & Cells(i, 7).Value 'email subject
      strbody = "Dear " & Cells(i, 14).Value & vbNewLine & "please update your project status" 'email body
      With OutMail
        .To = strto
        .Subject = strsub
        .Body = strbody
        .Send
      End With
      Set OutMail = Nothing
      Cells(i, 11) = "EMail Sent " & Now()
      Cells(i, 13) = "Y"
    End If
  End If
Next

Set OutApp = Nothing
ActiveWorkbook.Save
End Sub

and please edit your original post to comply with our "code tags rule" - see:

-----------

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Click on Edit to open your thread, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here