vba, Email multiple addresses with multiple rows ( Send multiples rows to a single email)

[ad aden]

Hello,
I'm looking for a solution with my Excel VBA problem.
Hopefully someone is able to help.

Im looking for a solution, to send multiples row to a same email address and the body of the email have to be all the information of each row

ID	Subject	Status	WH	Last Inbound Date	Actual Date	DWR	Email
15468​	caso 1	Pending	A1	date	date	date	A1@hotmail.com
6546​	caso 2	Pending	A6	date	date	date	A6@hotmail.com
5648​	caso 3	Pending	A6	date	date	date	A6@hotmail.com
45868​	caso 4	Pending	B1	date	date	date	B1@hotmail.com
40958​	caso 5	Pending	B6	date	date	date	B6@hotmail.com
54865​	caso 6	Pending	A1	date	date	date	A1@hotmail.com
45456​	caso 7	Pending	C1	date	date	date	C1@hotmail.com
215623​	caso 8	Pending	A6	date	date	date	A6@hotmail.com
56462​	caso 9	Pending	B6	date	date	date	B6@hotmail.com
86109​	caso 10	Pending	B6	date	date	date	B6@hotmail.com
35215​	caso 11	Pending	D1	date	date	date	D1@hotmail.com
65485​	caso 12	Pending	E1	date	date	date	E1@hotmail.com

In this case, each email addres match with the column WH
So Each email have to receive the information of all the row that apply on them.

Is someone able to help me with the code for this?
I've been searching, but I were not able to find the right coding.

Thanks in advance.

Kind regards, Ad.

 

[ad aden]

Hi Ad,
see the code below, adapted from a previous post of mine. Remember to adapt the sheet name and custom parts in the code.

Sub mailad_aden()
    'https://www.mrexcel.com/board/threads/vba-email-multiple-addresses-with-multiple-rows-send-multiples-rows-to-a-single-email.1218125/
  
    Dim Wks    As Worksheet
    Dim OutMail As Object, OutApp As Object
    Dim myRng  As Range
    Dim MyList   As Object
    Dim MyWh   As Variant
    Dim LastRow As Long
    Dim uniquesArray()
    Dim Dest   As String, strBody As String
  
    Set MyList = CreateObject("System.Collections.ArrayList")
    Set Wks = ThisWorkbook.Sheets("Sheet1")        '==> 'Adapt sheet name as needed
  
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
  
    With Wks
        For Each MyWh In .Range("D2", .Range("D" & .Rows.Count).End(xlUp))
            If Not MyList.Contains(MyWh.Value) Then MyList.Add MyWh.Value
        Next
    End With
  
    For Each MyWh In MyList
      
        Wks.Range("A1:H" & Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=4, Criteria1:=MyWh
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
      
        LastRow = Cells(Rows.Count, "A").End(xlUp).Row
      
        Set myRng = Wks.Range("A1:H" & LastRow).SpecialCells(xlCellTypeVisible)
      
        Dest = Cells(LastRow, "H").Value
        strBody = "Hi everyone," & "<br>" & "here's my message" & "<br/><br>" '==> to adapt
      
        With OutMail
            .To = Dest
            .CC = ""
            .BCC = ""
            .Subject = "Email Subject"        '==> to adapt
            .HTMLBody = strBody & RangetoHTML(myRng)
            .Display
            '.Send
        End With
        On Error GoTo 0
    Next
  
    On Error Resume Next
    Wks.ShowAllData
    On Error GoTo 0
  
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
  
End Sub
Function RangetoHTML(myRng As Range)
  
    Dim TempFile As String
    Dim TempWB As Workbook
    Dim fso    As Object
    Dim ts     As Object
    Dim i      As Integer
    Dim LastRow2 As Long
  
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    myRng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteAllUsingSourceTheme, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
      
        LastRow2 = .Cells(Rows.Count, "A").End(xlUp).Row + 1
      
        For i = 7 To 12
            With .UsedRange.Borders(i)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlMedium
            End With
        Next i
    End With
  
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).Range("A1:" & "G" & LastRow2).Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
  
    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=")
    TempWB.Close savechanges:=False
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

After testing you can edit this line for automatic message sending

'.Display
.Send

Hello Sequoyah,

Thanks for taking the time to give me this information, for some reason the functation rangetoHTML

You start a new “conversation”.

I think im not allow to, i dont find the button to new "conversation" but basically i want to know if you have a course, or what course you can recommend to a person that is really new in VBA.

 

[mumps]

Maybe the following links can give you a place to start:
Big Shoutout! Look at Post #4
Excel VBA Dictionary - A Complete Guide - Excel Macro Mastery
Excel VBA Array - The Complete Guide - Excel Macro Mastery

 

[Peter_SSs]

, if posible to write you on private to ask you a few questions?

To clarify: If the questions are about the thread or other Excel matters then that should be done publicly through the forum - definitely not through the conversation system.

 

[ad aden]

To clarify: If the questions are about the thread or other Excel matters then that should be done publicly through the forum - definitely not through the conversation system.

Thanks, i already did in the comments =D!! thanks for all the help!!

 

[atditiljazi]

i know this is an old post, but i am hoping for assistance regarding the vba code you shared. is it possible to send it as an attachment instead of placing it in the email body?

 

[mumps]

You will have a better chance of getting a solution if you start your own new thread.