Skip Sending an Email If Status is Yes (already sent)

[lharr28]

I have VBA to send bulk emails from a word template using outlook. I'm trying to figure out how to get the file to skip sending an email if the status for sent is marked as yes. Below I've included a screenshot of the excel file and the code I have so far. I'm fairly new to VBA and I'm thinking some kind of if statement is needed.

Sub sendMail()

Dim ol As Outlook.Application
Dim olm As Outlook.MailItem

Dim wd As Word.Application
Dim doc As Word.Document

Set ol = New Outlook.Application

'start from row 11 and go to the last row with data
Dim r As Integer

For r = 11 To Sheet4.Cells(Rows.Count, 1).End(xlUp).Row
    Set olm = ol.CreateItem(olMailItem)
    
    '***pulling the template to use, document must be saved as a word template!
    Set wd = New Word.Application
    Set doc = wd.documents.Open(Cells(6, 2).Value)

    With wd.Selection.Find
    .Text = "<<first name>>"
    .Replacement.Text = Sheet4.Cells(r, 2).Value '****info is in column 2 or B
    .Execute Replace:=wdReplaceAll
    End With
    
    With wd.Selection.Find
    .Text = "<<Merchant>>"
    .Replacement.Text = Sheet4.Cells(r, 4).Value '****info is in column 4 or D
    .Execute Replace:=wdReplaceAll
    End With
    
    With wd.Selection.Find
    .Text = "<<Amount>>"
    .Replacement.Text = Sheet4.Cells(r, 5).Value '****info is in column 5 or E
    .Execute Replace:=wdReplaceAll
    End With
    
    With wd.Selection.Find
    .Text = "<<transaction date>>"
    .Replacement.Text = Sheet4.Cells(r, 3).Value '****info is in column 5 or E
    .Execute Replace:=wdReplaceAll
    End With

    doc.Content.Copy
    
'Set the properties of the mail item, to, cc, subject, etc...
    With olm
        .Display
        .To = Sheet4.Cells(r, 6).Value
        .Subject = Sheet4.Cells(r, 8).Value
    
    'Copying the information from the word document into the body of the email
        Dim editor As Object
        Set editor = .GetInspector.WordEditor
        editor.Content.Paste
        '.Send
    End With

    Set olm = Nothing

    Application.DisplayAlerts = False
    doc.Close SaveChanges:=False
    Set doc = Nothing
    wd.Quit
    Set wd = Nothing
    Application.DisplayAlerts = True

Next

End Sub

 

[Trebor76]

Hi Iharr28,

Try this:

Option Explicit
Sub sendMail()

    'As the code uses early binding it needs references to:
    'Microsoft Outlook nn.n Object Library
    'Microsoft Word nn.n Object Library

    Dim ol As Outlook.Application
    Dim olm As Outlook.MailItem
    
    Dim wd As Word.Application
    Dim doc As Word.Document
    
    Set ol = New Outlook.Application
    
    'start from row 11 and go to the last row with data
    Dim r As Long
    
    For r = 11 To Sheet4.Cells(Rows.Count, 1).End(xlUp).Row
        If StrConv(Cells(r, "J"), vbProperCase) = "No" Then
            Set olm = ol.CreateItem(olMailItem)
            
            '***pulling the template to use, document must be saved as a word template!
            Set wd = New Word.Application
            Set doc = wd.documents.Open(Cells(6, 2).Value)
        
            With wd.Selection.Find
            .Text = "<<first name>>"
            .Replacement.Text = Sheet4.Cells(r, 2).Value '****info is in column 2 or B
            .Execute Replace:=wdReplaceAll
            End With
            
            With wd.Selection.Find
            .Text = "<<Merchant>>"
            .Replacement.Text = Sheet4.Cells(r, 4).Value '****info is in column 4 or D
            .Execute Replace:=wdReplaceAll
            End With
            
            With wd.Selection.Find
            .Text = "<<Amount>>"
            .Replacement.Text = Sheet4.Cells(r, 5).Value '****info is in column 5 or E
            .Execute Replace:=wdReplaceAll
            End With
            
            With wd.Selection.Find
            .Text = "<<transaction date>>"
            .Replacement.Text = Sheet4.Cells(r, 3).Value '****info is in column 5 or E
            .Execute Replace:=wdReplaceAll
            End With
        
            doc.Content.Copy
            
        'Set the properties of the mail item, to, cc, subject, etc...
            With olm
                .Display
                .To = Sheet4.Cells(r, 6).Value
                .Subject = Sheet4.Cells(r, 8).Value
            
            'Copying the information from the word document into the body of the email
                Dim editor As Object
                Set editor = .GetInspector.WordEditor
                editor.Content.Paste
                '.Send
            End With
        
            Set olm = Nothing
        
            Application.DisplayAlerts = False
            doc.Close SaveChanges:=False
            Set doc = Nothing
            wd.Quit
            Set wd = Nothing
            Application.DisplayAlerts = True
            
        End If
    
    Next r

End Sub

Regards,

Robert

 

[lharr28]

Hi Iharr28,

Try this:

Option Explicit
Sub sendMail()

    'As the code uses early binding it needs references to:
    'Microsoft Outlook nn.n Object Library
    'Microsoft Word nn.n Object Library

    Dim ol As Outlook.Application
    Dim olm As Outlook.MailItem
   
    Dim wd As Word.Application
    Dim doc As Word.Document
   
    Set ol = New Outlook.Application
   
    'start from row 11 and go to the last row with data
    Dim r As Long
   
    For r = 11 To Sheet4.Cells(Rows.Count, 1).End(xlUp).Row
        If StrConv(Cells(r, "J"), vbProperCase) = "No" Then
            Set olm = ol.CreateItem(olMailItem)
           
            '***pulling the template to use, document must be saved as a word template!
            Set wd = New Word.Application
            Set doc = wd.documents.Open(Cells(6, 2).Value)
       
            With wd.Selection.Find
            .Text = "<<first name>>"
            .Replacement.Text = Sheet4.Cells(r, 2).Value '****info is in column 2 or B
            .Execute Replace:=wdReplaceAll
            End With
           
            With wd.Selection.Find
            .Text = "<<Merchant>>"
            .Replacement.Text = Sheet4.Cells(r, 4).Value '****info is in column 4 or D
            .Execute Replace:=wdReplaceAll
            End With
           
            With wd.Selection.Find
            .Text = "<<Amount>>"
            .Replacement.Text = Sheet4.Cells(r, 5).Value '****info is in column 5 or E
            .Execute Replace:=wdReplaceAll
            End With
           
            With wd.Selection.Find
            .Text = "<<transaction date>>"
            .Replacement.Text = Sheet4.Cells(r, 3).Value '****info is in column 5 or E
            .Execute Replace:=wdReplaceAll
            End With
       
            doc.Content.Copy
           
        'Set the properties of the mail item, to, cc, subject, etc...
            With olm
                .Display
                .To = Sheet4.Cells(r, 6).Value
                .Subject = Sheet4.Cells(r, 8).Value
           
            'Copying the information from the word document into the body of the email
                Dim editor As Object
                Set editor = .GetInspector.WordEditor
                editor.Content.Paste
                '.Send
            End With
       
            Set olm = Nothing
       
            Application.DisplayAlerts = False
            doc.Close SaveChanges:=False
            Set doc = Nothing
            wd.Quit
            Set wd = Nothing
            Application.DisplayAlerts = True
           
        End If
   
    Next r

End Sub

Regards,

Robert

Thanks Robert! It works perfectly! Would you happen to have a good reference that explains "If StrConv(Cells(r, "J"), vbProperCase)"?

 

[Trebor76]

Thanks Robert! It works perfectly!

That's great and you're welcome.

Would you happen to have a good reference that explains "If StrConv(Cells(r, "J"), vbProperCase)"?

The code is checking the active row (r) in Col. J and if the text is "No" (I use proper case so there's no question on matching the text) it runs the script else it goes to the next row (r).