learningVBA321
New Member
- Joined
- Jul 10, 2017
- Messages
- 30
<tbody>
[TD="class: votecell"][/TD]
[TD="class: postcell"] 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
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][/TD]
</tbody>
Last edited:
