VBA Mail a row to each person in a range

[rezacs]

I have some rows of data in a spreadsheet that needs to be sent to different groups depending on the group name or email that is set for it.

Using come code found on Ron Debruin's site I was able to get most of the way there, but there are some items I can't figure out.

The data rows are as follows:

[TABLE="width: 2294"]
<tbody>[TR]
[TD]Group Name[/TD]
[TD]Group Email[/TD]
[TD]Send?[/TD]
[TD]Move Effective Date[/TD]
[TD]Customer Name[/TD]
[TD]Company Name[/TD]
[TD]Customer Number[/TD]
[TD]Previous Delivery Address[/TD]
[TD]Previous Suite/Apartment[/TD]
[TD]Previous City[/TD]
[TD]Previous State[/TD]
[TD]Previous ZIP+4[/TD]
[TD]Current Delivery Address[/TD]
[TD]Current Suite/Apartment[/TD]
[TD]Current City[/TD]
[TD]Current State[/TD]
[TD]Current ZIP+4[/TD]
[TD]Return Mail Code[/TD]
[/TR]
[TR]
[TD]Group 1[/TD]
[TD]group1@email.com[/TD]
[TD]Yes[/TD]
[TD="align: right"]08/01/2018[/TD]
[TD]Customer 1[/TD]
[TD][/TD]
[TD="align: right"]12345601[/TD]
[TD]p-address 1[/TD]
[TD][/TD]
[TD]p-city 1[/TD]
[TD]p-state 1[/TD]
[TD="align: right"]555555555[/TD]
[TD]c-address 1[/TD]
[TD][/TD]
[TD]c-city 1[/TD]
[TD]c-state 1[/TD]
[TD="align: right"]555555555[/TD]
[TD]Individual Move[/TD]
[/TR]
[TR]
[TD]Group 1[/TD]
[TD]group1@email.com[/TD]
[TD]Yes[/TD]
[TD="align: right"]07/01/2018[/TD]
[TD]Customer 2[/TD]
[TD][/TD]
[TD="align: right"]12345602[/TD]
[TD]p-address 2[/TD]
[TD][/TD]
[TD]p-city 1[/TD]
[TD]p-state 1[/TD]
[TD="align: right"]554443333[/TD]
[TD]c-address 1[/TD]
[TD][/TD]
[TD]c-city 2[/TD]
[TD]c-state 2[/TD]
[TD="align: right"]554443333[/TD]
[TD]Individual Move[/TD]
[/TR]
[TR]
[TD]Group 2[/TD]
[TD]group2@email.com[/TD]
[TD]Yes[/TD]
[TD="align: right"]06/01/2018[/TD]
[TD]Customer 3[/TD]
[TD][/TD]
[TD="align: right"]12345603[/TD]
[TD]p-address 2[/TD]
[TD][/TD]
[TD]p-city 1[/TD]
[TD]p-state 1[/TD]
[TD="align: right"]45678[/TD]
[TD]c-address 1[/TD]
[TD][/TD]
[TD]c-city 3[/TD]
[TD]c-state 3[/TD]
[TD="align: right"]45678[/TD]
[TD]Individual Move[/TD]
[/TR]
</tbody>[/TABLE]

As it is the emails are being created successfully and the data is aligning as it would be in a table, but it is hard to read and the first 3 columns and last column are being displayed in the table.

4 things i want to accomplish
1. Display only data from columns 4 through 17 in the table in the email.
2. Display borders around the data forming a full grid so it looks cleaner and easier to read
3. Display the data in column 18 as part of the general body of text separate from the table.
4. If multiple lines of data exist for the same group, send only one email containing all rows of data pertaining to that group. Currently it includes all data going to the same group, but sends an email to the same email address each time the group is displayed in the list.

Sub Send_Row()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Don't forget to copy the function RangetoHTML in the module.
'Working in Excel 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim rng As Range
    Dim Ash As Worksheet
              
    Set Ash = ActiveSheet
    On Error GoTo cleanup
    Set OutApp = CreateObject("Outlook.Application")


    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With


    For Each cell In Ash.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" _
           And LCase(cell.Offset(0, 1).Value) = "yes" Then


            'Change the filter range and filter Field if needed
            'It will filter on Column B now (mail addresses)
            Ash.Range("A1:R20").AutoFilter Field:=2, Criteria1:=cell.Value


            With Ash.AutoFilter.Range
                On Error Resume Next
                Set rng = .SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
            End With


            Set OutMail = OutApp.CreateItem(0)


            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Mail Delivery Address Update"
                .HTMLBody = RangetoHTML(rng)
                .Display  'Or use .Send
            End With
            On Error GoTo 0


            Set OutMail = Nothing
            Ash.AutoFilterMode = False
        End If
    Next cell


cleanup:
    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub




Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Thank you.

 

[Macropod]

This is the kind of thing one might do using a mailmerge from Word, in conjunction with a DATABASE field. An outline of this approach can be found at: http://answers.microsoft.com/en-us/...g-tables/8bce1798-fbe8-41f9-a121-1996c14dca5d
Alternatively, if you're using and Excel workbook with a separate table containing just a single instance of each of the group identifiers (e.g. names or email addresses), a DATABASE field in a normal ‘letter’ mailmerge could be used without the need for a macro. An outline of this approach can be found at:
https://answers.microsoft.com/en-us...gle-page/4edb4654-27e0-47d2-bd5f-8642e46fa103
For a working example, see:
http://www.msofficeforums.com/mail-merge/37844-mail-merge-using-one-excel-file-multiple.html

 

[rezacs]

This is the kind of thing one might do using a mailmerge from Word, in conjunction with a DATABASE field. An outline of this approach can be found at: http://answers.microsoft.com/en-us/...g-tables/8bce1798-fbe8-41f9-a121-1996c14dca5d
Alternatively, if you're using and Excel workbook with a separate table containing just a single instance of each of the group identifiers (e.g. names or email addresses), a DATABASE field in a normal ‘letter’ mailmerge could be used without the need for a macro. An outline of this approach can be found at:
https://answers.microsoft.com/en-us...gle-page/4edb4654-27e0-47d2-bd5f-8642e46fa103
For a working example, see:
http://www.msofficeforums.com/mail-merge/37844-mail-merge-using-one-excel-file-multiple.html

I may have missed something, but it seems to be able to merge into an email I would need to install software(add on) to accomplish this which based on our security rules is not possible without lengthy review which is still no guarantee they will allow it.
Otherwise all the other code seems to indicate creating a mail merge into a word document which would then still require me to break those out, create a new email and attach the document for anywhere from 1 to 50 different groups each time this is needed.

All we use this data for is to update our customer database when postal mail delivery fails, to contact active customers in case of a move or some other reason for address change so we can ensure our system has the updated info. Otherwise in this scenario we do not use the addresses to actually send postal mail, but rather emails containing the postal info of the customers each group is responsible for.
So in the table data i provided, 2 customers need to go to group 1 to be checked and 1 customer needs to go to group 2 to be checked.

Right now the code I posted does the basics of what I need, however it is sending more info than I need in too many emails(for groups that have more than 1 line of data) and in a bit of a messy format. I'm hoping there are some relatively simply modifications I can made to the code to remedy these issues. Or I guess just a clearer understanding of other ways to make it work.

Sorry if this is what you were trying to say, I may just not be getting what those sites are saying in a way that relates to my scenario.

 

[Macropod]

I may have missed something, but it seems to be able to merge into an email I would need to install software(add on) to accomplish this which based on our security rules is not possible without lengthy review which is still no guarantee they will allow it.

Not so. All the functionality is built into Office.

 

[rezacs]

I think i get the direction you were trying to go. However a mail merge wasn't quite what I was looking for, I needed it to create an email with the information from the spreadsheet included.

I did some more digging and found another piece of code on Ron Debruin's site that was written to do exactly that. With some slight modifications and supporting code I was able to get it to do exactly what I needed.

Thanks for your help.

 

[Macropod]

a mail merge wasn't quite what I was looking for, I needed it to create an email with the information from the spreadsheet included.

Which is well within the capacity of a mailmerge...