I am using code to generate multiple emails from an Excel sheet - see the example below.

Example Spreadsheet

I am using the code below to generate an email for each row, with the recipient in Column C. It also pulls the date from Column D into the body of the email and attaches the file linked in Column E if there is one. The code works great, but it generates an email when there is no email address in the Column C. I want it to skip over any rows with no email address in Column C rather than generating an email. Can anyone advise on code to add? Thank you!!

Sub CreateEmails()

    Dim sourceWorksheet As Worksheet
    Set sourceWorksheet = Worksheets("Sheet1")

    Dim lastRow As Long
    With sourceWorksheet
        lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row 'this is the column with the recipients
    End With

    Dim OutlookApp As Object
    Set OutlookApp = CreateObject("Outlook.Application")

    Dim rowIndex As Long
    For rowIndex = 2 To lastRow 'start at the second row

    Dim MItem As Object
    Set MItem = OutlookApp.CreateItem(0)

    With MItem
        .To = sourceWorksheet.Cells(rowIndex, "C").Value
        .Subject = "Subject here"
        .CC = "[email protected]"
        .Attachments.Add "attachment link here"

        If Cells(rowIndex, 11) <> "" Then .Attachments.Add Cells(rowIndex, 5).Value 
      'adds a second attachment if there is a link in column E
        .htmlBody = "<p><font face = ""Calibri(Body)"" font size=""3"" color=""black"">Good afternoon, </p>" & _
       "<p><font face = ""Calibri(Body)"" font size=""3"" color=""black""><strong>Please review the attached and return by " & Cells(rowIndex, 4) & ".</strong>  </p>" & _
       "<p><font face = ""Calibri(Body)"" font size=""3"" color=""black"">Please reach out to me if you have any questions. </p>"& .htmlBody

        .display 'Change to .send to send automatically
    End With

    Next rowIndex
End Sub

CodePudding user response：

Like this:

Sub CreateEmails()

    Dim wsSrc As Worksheet
    Dim lastRow As Long
    Dim OutlookApp As Object
    Dim rowIndex As Long
    Dim MItem As Object, sTo As String, rw As Range
    
    Set wsSrc = Worksheets("Sheet1")
    
    Set OutlookApp = CreateObject("Outlook.Application")

    For rowIndex = 2 To wsSrc.Cells(wsSrc.Rows.Count, "C").End(xlUp).Row
        Set rw = wsSrc.Rows(rowIndex) 'the row we're on...
        sTo = rw.Columns("C").value
        If Len(sTo) > 0 Then           '<<< need to create a mail?
            With OutlookApp.CreateItem(0)
                .To = sTo
                .Subject = "Subject here"
                .CC = "[email protected]"
                .Attachments.Add "attachment link here"
        
                If rw.Columns("K").value <> "" Then .Attachments.Add rw.Columns("E").value
                 'adds a second attachment if there is a link in column E
                .htmlBody = "<p><font face = ""Calibri(Body)"" font size=""3"" color=""black"">Good afternoon, </p>" & _
                    "<p><font face = ""Calibri(Body)"" font size=""3"" color=""black"">" & _
                    "<strong>Please review the attached and return by " & Cells(rowIndex, 4) & ".</strong>  </p>" & _
                    "<p><font face = ""Calibri(Body)"" font size=""3"" color=""black"">" & _
                    "Please reach out to me if you have any questions. </p>" & .htmlBody
        
                .display 'Change to .send to send automatically
            End With
        End If 'have To address
    Next rowIndex
End Sub