Consulting

Results 1 to 2 of 2

Thread: Send Emails from Excel with Dynamic Range Selection

  1. #1

    Send Emails from Excel with Dynamic Range Selection

    Hi there,

    I am very new to the VBA world so please excuse my pace in understanding your brilliant responses.

    The task at hand involves sending weekly emails to 4 different sets of recipients. With each set of recipients, they will receive a table of data in the body of the email that is relevant to them. The table of data in my worksheet is dynamic with respects to the number of rows it includes on a weekly basis.

    I put together a code that allowed me to get far enough into automating the emailing process but I am now stuck at the stage where I have to select/copy/paste the dynamic data range to include in the body of the email. In my code below, I set up "ca11_table" and "ca12_table" as strings (they are the dynamic data ranges) and I want to include them as part of my "mail_body_message" which is cell K2 that includes the text of the email. ca11_table and ca12_table would be located in a different worksheet.

    Thanks in advance for your support!




    Sub SENDEMAILS(what_address As String, what_cc As String, what_bcc As String, subject_line As String, mail_body As String)


    Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")


    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)

    olMail.To = what_address
    olMail.CC = what_cc
    olMail.BCC = what_bcc
    olMail.Subject = subject_line
    olMail.BodyFormat = olFormatHTML
    olMail.HTMLBody = mail_body
    olMail.Display


    End Sub


    Sub Sendmassemail()


    row_number = 1


    Do
    DoEvents
    row_number = row_number + 1
    Dim mail_body_message As String
    Dim full_name As String
    Dim ca11_table As String
    Dim ca12_table As String

    mail_body_message = Sheet1.Range("K2")
    full_name = Sheet1.Range("D" & row_number) & " " & Sheet1.Range("E" & row_number)
    mail_body_message = Replace(mail_body_message, "replace_name_here", full_name)
    Call SENDEMAILS(Sheet1.Range("A" & row_number), Sheet1.Range("B" & row_number), Sheet1.Range("C" & row_number), "Weekly Email Subjectline", mail_body_message)

    Loop Until row_number = 10


    End Sub

  2. #2
    So I was able to figure out a way to bring in the ca11_table and ca12_table into the body of the email using Functions but now my issue is formatting. My current code brings in all the text in what appears to be a default font and size, even so for the tables (no borders or formatting from the Excel sheet). How do I go about changing my current code in order to bring in the same formatting in the body of the email? I am most concerned with including the formatting of the tables from Excel: borders and colours.

    Current code:

    Sub GenerateEmails(what_address As String, what_cc As String, what_bcc As String, subject_line As String, mail_body As String)


    Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")


    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)

    olMail.To = what_address
    olMail.CC = what_cc
    olMail.BCC = what_bcc
    olMail.Subject = subject_line
    olMail.BodyFormat = olFormatHTML
    olMail.HTMLBody = mail_body
    olMail.Display


    End Sub




    Function GetCA11Data() As String


    Dim CA11Column As Range, CA11Row As Range, r As Range, c As Range
    Dim str As String

    Sheet11.Activate
    Set CA11Column = Range("B1", Range("B1").End(xlDown))

    str = "<table>"

    For Each r In CA11Column

    str = str & "<tr>"

    Set CA11Row = Range(r, r.End(xlToRight))
    For Each c In CA11Row

    str = str & "<td>" & c.Value & "</td>"

    Next c

    str = str & "</tr>"

    Next r

    str = str & "</table>"

    GetCA11Data = str


    End Function


    Function GetCA12Data() As String


    Dim CA12Column As Range, CA12Row As Range, r As Range, c As Range
    Dim str As String

    Sheet11.Activate
    Set CA12Column = Range("S1", Range("S1").End(xlDown))

    str = "<table>"

    For Each r In CA12Column

    str = str & "<tr>"

    Set CA12Row = Range(r, r.End(xlToRight))
    For Each c In CA12Row

    str = str & "<td>" & c.Value & "</td>"

    Next c

    str = str & "</tr>"

    Next r

    str = str & "</table>"

    GetCA12Data = str


    End Function


    Sub GenerateMassEmails()


    row_number = 1


    Do
    DoEvents
    row_number = row_number + 1
    Dim mail_body_message As String
    Dim full_subject As String

    mail_body_message = Sheet1.Range("K2")
    full_subject = Sheet1.Range("D" & row_number) & " POs as of " & Sheet1.Range("E" & row_number)
    mail_body_message = Replace(mail_body_message, "ca11_table_replace", GetCA11Data)
    mail_body_message = Replace(mail_body_message, "ca12_table_replace", GetCA12Data)
    Call GenerateEmails(Sheet1.Range("A" & row_number), Sheet1.Range("B" & row_number), Sheet1.Range("C" & row_number), full_subject, mail_body_message)

    Loop Until row_number = 2


    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •