Sub email_Advice()
Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngRef As Range
Dim rngBody As Range
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
ID = CreateObject("WScript.Network").UserName
Range("V8").Select
XX = ActiveCell.Row
Next_Ref:
If Range("V" & XX).Value = "" Then
If ActiveCell.Offset(0, -1).Value = "" Then
Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
Exit Sub
Else
MsgBox ("Click to generate for next vendor")
With ActiveSheet
Set rngTo = .Range("M" & XX)
Set rngSubject = .Range("O" & XX)
Set rngBody = .Range("P" & XX)
Set rngRef = .Range("T" & XX)
End With
With objMail
.To = rngTo.Value
.Subject = rngSubject.Value
.Body = rngBody.Value
.Attachments.Add "C:\Users\" & ID & "\Desktop\WHT \" & rngRef & ".pdf"
.Send
End With
ActiveCell.Value = "YES"
ActiveCell.Offset(1, 0).Select
XX = XX + 1
GoTo Next_Ref
End If
Else
Exit Sub
End If
End Sub
I executed the code above and was expecting it to loop through each rows, picking the necessary information to send an email, until a blank cell is reached. However, the code always encounters below error on the 2nd row: "Run time error" with the description: "The items has been moved or deleted"
Untested
Option Explicit
Sub email_Advice()
Dim objOutlook As Object, objMail As Object
Dim ID As String, FOLDER as String
Dim lastrow As Long, r As Long, n As Long
ID = CreateObject("WScript.Network").UserName
FOLDER = "C:\Users\" & ID & "\Desktop\WHT \"
Set objOutlook = CreateObject("Outlook.Application")
With ActiveSheet
lastrow = .Cells(.Rows.Count, "U").End(xlUp).Row
For r = 8 To lastrow
If .Cells(r, "V") = "" Then
If vbYes = MsgBox("Generate for vendor " & .Cells(r, "M"), vbYesNo) Then
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = .Cells(r, "M")
.Subject = .Cells(r, "O")
.Body = .Cells(r, "P")
.Attachments.Add FOLDER & .Cells(r, "T") & ".pdf"
.Send
End With
.Cells(r, "V") = "YES"
n = n + 1
End If
End If
Next
End With
Set objOutlook = Nothing
Set objMail = Nothing
MsgBox n & " emails sent", vbInformation
End Sub