Create Email from Excel Using a Loop to Go Through Rows

learningVBA321

New Member
Joined
Jul 10, 2017
Messages
30
I have a sheet from which I loop through each row and create an email for each row. Attachments are based on the Division name. Currently, it creates an email for every row, so if one person under Name has, say 8 divisions, they will receive 8 emails, each with a different attachment. I want to have it loop and if if finds the same Name, then create one email for that Name, with all their Division reports attached. It would then move on to the next row, or skip the row if it was a dupe name/address to the row above it.
In this example, I would want it to create one email to the Name Sample Sample1, with attachments for Widgets and Doorknobs. Then for the rest, they would each get their usual one email.
The below code works except I cannot figure out the correct way to get it to continue looping. It works as intended unless it hits another set of dupe names, at which point it will create a single email with the first row's attachment, and then goes and creates the next email with both attachments for that same name. I just need to get this to skip the rows correctly in my loop, so it does not create that 'in-between' email with only one attachment. It works for the first two in this sheet, but then if there were a Sample2 followed by another Sample2, it creates the extra 'in-between' email before creating the email with both attachments. Thanks
Cross-posted here: https://stackoverflow.com/questions/47685381/create-email-from-excel-using-a-loop-to-go-through-rows

GzCkN.jpg


Code:
<code>Sub SendMail()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strdir As String
Dim strFilename As String
Dim sigString As String
Dim strBody As String
Dim strName As Variant
Dim strName1 As Variant
Dim strDept As Variant
Dim strName2 As String
Dim strName3 As Variant
Dim strName4 As String
Dim strName5 As Variant

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

sigString = Environ("appdata") & _
            "\Microsoft\Signatures\Test.htm"

    If Dir(sigString) <> "" Then
     signature = GetBoiler(sigString)
     Else
     signature = ""
    End If

strdir = "z:\"

strBody = "[FONT=calibri]Please review the attached report for your department."  

  For Each person In Range("b2:b9").Cells.SpecialCells(xlCellTypeConstants)
      Set strName = person.Offset(0, -1)
      Set strName1 = person.Offset(0, 2)
      Set strName3 = person.Offset(1, 0)
      Set strDept = person.Offset(1, 2)
      Set strName5 = person.Offset(1, -1)

      If person = strName3 Then

      Set OutMail = OutApp.CreateItem(0)

    With OutMail
        strFilename = Dir("z:\" & strName1 & "*")
        strFilename1 = Dir("z:\" & strDept & "*")
         strName2 = Left(strName, InStr(strName & " ", " ") - 1)
            .To = person.Value
            .Subject = "Monthly Report for " & strName1
            .HTMLBody = "[FONT=calibri]" & "Dear " & strName2 & ",

" & signature
            .Attachments.Add strdir & strFilename
            .Attachments.Add strdir & strFilename1
            .Display  'Or use Send
    End With
    Else: person = person.Offset(1, 0)

    Set OutMail = OutApp.CreateItem(0)

    With OutMail

        strFilename1 = Dir("z:\" & strDept & "*")
         strName4 = Left(strName5, InStr(strName & " ", " ") - 1)
            .To = strName3
            .Subject = "Monthly Report for " & strDept
            .HTMLBody = "[FONT=calibri]" & "Dear " & strName4 & ",

" & signature
            .Attachments.Add strdir & strFilename1
            .Display  'Or use Send
    End With

    End If
    Next person

End Sub



Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.ReadAll
ts.Close
End Function[/FONT][/FONT][/FONT]</code>[FONT=calibri][FONT=calibri][FONT=calibri]


[/FONT][/FONT][/FONT]

<tbody>
</tbody>
 
Last edited:

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

learningVBA321

New Member
Joined
Jul 10, 2017
Messages
30
I tried to do this with a dictionary but could not get the arguments to add in, just to give an idea of options I have tried.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,694
Messages
5,597,571
Members
414,156
Latest member
WDMix

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top