vBA Outlook Script

[Lukums]

Morning guys,

I have the attached script (obtained from the NET this isn't mine).
It works as intended no issues however, I wish to manipulate it to do the following:

Once that line has converted into an email I wish to place a "1" against that row in column H.
If the script runs again it won't run if that line contains >= 0

The issue I have is I don't know how to add to:

If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then

Parameter to say - also look at Column H for a value.

Sub test()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim i As Long
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    
    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
        LCase(Cells(cell.Row, "C").Value) = "yes" Then

           
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "Please contact us to discuss bringing " & _
                        "your account up to date"
            
                .Send
            End With
            On Error GoTo 0
            Set OutMail = Nothing
            
            End If

Next cell
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Many thanks.

 

[mrshl9898]

So run only if H is 0, and add a 1 after the code runs?

Sub test()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim i As Long
   
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
   
    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And LCase(Cells(cell.Row, "C").Value) = "yes" And Cells(cell.Row, "H").Value = 0 Then  '''here

          
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "Please contact us to discuss bringing " & _
                        "your account up to date"
           
                .Send
            End With
            On Error GoTo 0
            Set OutMail = Nothing
           
            End If

Cells(cell.Row, "H").Value = 1   '''here
Next cell
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

 

[Lukums]

You got it! Thank you thank you!