VBA To Create (But Not To Send) E-mail Drafts Based On Table

CyrusTheVirus

CyrusTheVirus

Well-known Member
Joined
Jan 28, 2015
Messages
749
Office Version
  1. 365
Platform
  1. Windows
Hi everyone,

Looking for a code that will populate e-mail drafts within outlook, but not send them out, based on information within a table. The table name is Email_Table, and the sheet is Sheet1.

Specifically, what I need to populate within the e-mail is:

1) The subject which is in cell B1.

2) The body, which is in cell B2, but I need the body to be two lines below "Hi (insert first name of supervisor (only one time) from column 1 of Email_Table),".

3) Headers from table (copy/pasted), with corresponding data per supervisor (copy/pasted), but ONLY for table columns 3, 4, 5, 8, 9, 10, 11, 12, 13, 14, 15, 17... to clarify I need one e-mail to be drafted for each supervisor listing out all of their items, the below example shows some supervisors with 1 item, 2 items, and 4 items. Below is an example of what Sheet1 looks like, and below that is an example of the 4 e-mails that I would want populated (but not sent, so drafted) within outlook.

Can anyone please help with this?


[TABLE="width: 1957"]
<tbody>[TR]
[TD]Subject:[/TD]
[TD]Outstanding Items[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Body:[/TD]
[TD="colspan: 6"]The below item(s) are outstanding. If these are already resolved, then please ignore this e-mail. Also, please let me know if you need assistance with this.[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Email_Table[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]First Name[/TD]
[TD]Supervisor E-mail Address[/TD]
[TD]Supervisor Name[/TD]
[TD]Employee Name[/TD]
[TD]Hourly/Salary[/TD]
[TD]Employee No.[/TD]
[TD]Employee Info[/TD]
[TD]Pin[/TD]
[TD]Location No.[/TD]
[TD]Location Name[/TD]
[TD]Date In[/TD]
[TD]Time In[/TD]
[TD]Date Out[/TD]
[TD]Time Out[/TD]
[TD]Requested Date[/TD]
[TD]Options[/TD]
[TD]Notes[/TD]
[/TR]
[TR]
[TD]Anne[/TD]
[TD]AApple@123.org[/TD]
[TD]Apple, Amanda[/TD]
[TD]Smith, John[/TD]
[TD]Hourly[/TD]
[TD="align: right"]1235[/TD]
[TD]Smith, John[/TD]
[TD="align: right"]600[/TD]
[TD]009012[/TD]
[TD]Accounting[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]2/6/2019[/TD]
[TD]12:04:26[/TD]
[TD][/TD]
[TD][/TD]
[TD]Call In Missing or Not Approved[/TD]
[/TR]
[TR]
[TD]Kelli[/TD]
[TD]KBlacksmith@123.org[/TD]
[TD]Blacksmith, Kelli[/TD]
[TD]Rogers, Andrea[/TD]
[TD]Salary[/TD]
[TD="align: right"]5168[/TD]
[TD]Rogers, Andrea[/TD]
[TD="align: right"]100[/TD]
[TD]002000[/TD]
[TD]HR[/TD]
[TD="align: right"]2/12/2019[/TD]
[TD]07:54:55[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Call Out Missing or Not Approved[/TD]
[/TR]
[TR]
[TD]George[/TD]
[TD]GCurry@123.org[/TD]
[TD]Curry, George[/TD]
[TD]Salem, Travis[/TD]
[TD]Hourly[/TD]
[TD="align: right"]54545[/TD]
[TD]Salem, Travis[/TD]
[TD="align: right"]301[/TD]
[TD]002600[/TD]
[TD]Warehouse[/TD]
[TD="align: right"]2/11/2019[/TD]
[TD]13:21:38[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Call Out Missing or Not Approved[/TD]
[/TR]
[TR]
[TD]George[/TD]
[TD]GCurry@123.org[/TD]
[TD]Curry, George[/TD]
[TD]Salem, Travis[/TD]
[TD]Hourly[/TD]
[TD="align: right"]66464[/TD]
[TD]Salem, Travis[/TD]
[TD="align: right"]102[/TD]
[TD]009102[/TD]
[TD]Warehouse[/TD]
[TD="align: right"]2/12/2019[/TD]
[TD]13:16:32[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Call Out Missing or Not Approved[/TD]
[/TR]
[TR]
[TD]Michelle[/TD]
[TD]MMiller@123.org[/TD]
[TD]Miller, Michelle[/TD]
[TD]Russell, Corey[/TD]
[TD]Hourly[/TD]
[TD="align: right"]848[/TD]
[TD]Russell, Corey[/TD]
[TD="align: right"]102[/TD]
[TD]009102[/TD]
[TD]Warehouse[/TD]
[TD="align: right"]2/12/2019[/TD]
[TD]12:33:04[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Call Out Missing or Not Approved[/TD]
[/TR]
[TR]
[TD]Michelle[/TD]
[TD]MMiller@123.org[/TD]
[TD]Miller, Michelle[/TD]
[TD]Russell, Corey[/TD]
[TD]Salary[/TD]
[TD="align: right"]848[/TD]
[TD]Russell, Corey[/TD]
[TD="align: right"]311[/TD]
[TD]002802[/TD]
[TD]House[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]2/12/2019[/TD]
[TD]10:15:01[/TD]
[TD][/TD]
[TD][/TD]
[TD]Call In Missing or Not Approved[/TD]
[/TR]
[TR]
[TD]Michelle[/TD]
[TD]MMiller@123.org[/TD]
[TD]Miller, Michelle[/TD]
[TD]Smith, Sean[/TD]
[TD]Salary[/TD]
[TD="align: right"]545[/TD]
[TD]Smith, Sean[/TD]
[TD="align: right"]311[/TD]
[TD]002802[/TD]
[TD]House[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]2/12/2019[/TD]
[TD]10:15:01[/TD]
[TD][/TD]
[TD][/TD]
[TD]Call In Missing or Not Approved[/TD]
[/TR]
[TR]
[TD]Michelle[/TD]
[TD]MMiller@123.org[/TD]
[TD]Miller, Michelle[/TD]
[TD]Tompkins, Brian[/TD]
[TD]Salary[/TD]
[TD="align: right"]949[/TD]
[TD]Tompkins, Brian[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]2/12/2019[/TD]
[TD="align: right"]3[/TD]
[TD]Calendar Request Pending Approval[/TD]
[/TR]
</tbody>[/TABLE]




[TABLE="width: 1016"]
<tbody>[TR]
[TD]Hi Amanda,[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 12"]The below item(s) are outstanding. If these are already resolved, then please ignore this e-mail. Also, please let me know if you need assistance with this.[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Supervisor Name[/TD]
[TD]Employee Name[/TD]
[TD]Hourly/Salary[/TD]
[TD]Pin[/TD]
[TD]Location No.[/TD]
[TD]Location Name[/TD]
[TD]Date In[/TD]
[TD]Time In[/TD]
[TD]Date Out[/TD]
[TD]Time Out[/TD]
[TD]Requested Date[/TD]
[TD]Notes[/TD]
[/TR]
[TR]
[TD]Apple, Amanda[/TD]
[TD]Smith, John[/TD]
[TD]Hourly[/TD]
[TD="align: right"]600[/TD]
[TD]009012[/TD]
[TD]Accounting[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]2/6/2019[/TD]
[TD]12:04:26[/TD]
[TD][/TD]
[TD]Call In Missing or Not Approved[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Hi Kelli,[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 12"]The below item(s) are outstanding. If these are already resolved, then please ignore this e-mail. Also, please let me know if you need assistance with this.[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Supervisor Name[/TD]
[TD]Employee Name[/TD]
[TD]Hourly/Salary[/TD]
[TD]Pin[/TD]
[TD]Location No.[/TD]
[TD]Location Name[/TD]
[TD]Date In[/TD]
[TD]Time In[/TD]
[TD]Date Out[/TD]
[TD]Time Out[/TD]
[TD]Requested Date[/TD]
[TD]Notes[/TD]
[/TR]
[TR]
[TD]Blacksmith, Kelli[/TD]
[TD]Rogers, Andrea[/TD]
[TD]Salary[/TD]
[TD="align: right"]100[/TD]
[TD]002000[/TD]
[TD]HR[/TD]
[TD="align: right"]2/12/2019[/TD]
[TD]07:54:55[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Call Out Missing or Not Approved[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Hi George,[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 12"]The below item(s) are outstanding. If these are already resolved, then please ignore this e-mail. Also, please let me know if you need assistance with this.[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Supervisor Name[/TD]
[TD]Employee Name[/TD]
[TD]Hourly/Salary[/TD]
[TD]Pin[/TD]
[TD]Location No.[/TD]
[TD]Location Name[/TD]
[TD]Date In[/TD]
[TD]Time In[/TD]
[TD]Date Out[/TD]
[TD]Time Out[/TD]
[TD]Requested Date[/TD]
[TD]Notes[/TD]
[/TR]
[TR]
[TD]Curry, George[/TD]
[TD]Salem, Travis[/TD]
[TD]Hourly[/TD]
[TD="align: right"]301[/TD]
[TD]002600[/TD]
[TD]Warehouse[/TD]
[TD="align: right"]2/11/2019[/TD]
[TD]13:21:38[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Call Out Missing or Not Approved[/TD]
[/TR]
[TR]
[TD]Curry, George[/TD]
[TD]Salem, Travis[/TD]
[TD]Hourly[/TD]
[TD="align: right"]102[/TD]
[TD]009102[/TD]
[TD]Warehouse[/TD]
[TD="align: right"]2/12/2019[/TD]
[TD]13:16:32[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Call Out Missing or Not Approved[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Hi Michelle,[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 12"]The below item(s) are outstanding withim. If these are already resolved, then please ignore this e-mail. Also, please let me know if you need assistance with this.[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Supervisor Name[/TD]
[TD]Employee Name[/TD]
[TD]Hourly/Salary[/TD]
[TD]Pin[/TD]
[TD]Location No.[/TD]
[TD]Location Name[/TD]
[TD]Date In[/TD]
[TD]Time In[/TD]
[TD]Date Out[/TD]
[TD]Time Out[/TD]
[TD]Requested Date[/TD]
[TD]Notes[/TD]
[/TR]
[TR]
[TD]Miller, Michelle[/TD]
[TD]Russell, Corey[/TD]
[TD]Hourly[/TD]
[TD="align: right"]102[/TD]
[TD]009102[/TD]
[TD]Warehouse[/TD]
[TD="align: right"]2/12/2019[/TD]
[TD]12:33:04[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Call Out Missing or Not Approved[/TD]
[/TR]
[TR]
[TD]Miller, Michelle[/TD]
[TD]Russell, Corey[/TD]
[TD]Salary[/TD]
[TD="align: right"]311[/TD]
[TD]002802[/TD]
[TD]House[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]2/12/2019[/TD]
[TD]10:15:01[/TD]
[TD][/TD]
[TD]Call In Missing or Not Approved[/TD]
[/TR]
[TR]
[TD]Miller, Michelle[/TD]
[TD]Smith, Sean[/TD]
[TD]Salary[/TD]
[TD="align: right"]311[/TD]
[TD]002802[/TD]
[TD]House[/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]2/12/2019[/TD]
[TD]10:15:01[/TD]
[TD][/TD]
[TD]Call In Missing or Not Approved[/TD]
[/TR]
[TR]
[TD]Miller, Michelle[/TD]
[TD]Tompkins, Brian[/TD]
[TD]Salary[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]2/12/2019[/TD]
[TD]Calendar Request Pending Approval[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Sort by date Sort by votes
Please have a look at Ron de Bruin's first-class information, https://www.rondebruin.nl/win/s1/outlook/mail.htm

Maybe use .Display instead of .Send to not send the message. I'm sure Ron will cover it somewhere, been a while since I've done that sort of thing.

As good as Ron's site is, if you need further help Google will find all you need. all the best Fazza
 
Upvote 0
Fazza said:
Please have a look at Ron de Bruin's first-class information, https://www.rondebruin.nl/win/s1/outlook/mail.htm

Maybe use .Display instead of .Send to not send the message. I'm sure Ron will cover it somewhere, been a while since I've done that sort of thing.

As good as Ron's site is, if you need further help Google will find all you need. all the best Fazza
Click to expand...

Thanks Fazza, I'll give it a read. Though, VBA just isn't my thing, I rarely use it.... spent my time studying formulas/features instead. Perhaps I'll give it a whirl if no one provides a code.
 
Upvote 0
hi,
I had some time to look at this. Built it around Ron's code. Assumes your data worksheet is active & like you posted. Please modify as required.
regards

Code: 
Sub Maybe()


    Const lCOLUMN_WITH_ID As Long = 2 'Column B of input worksheet has email addresses
    
    Dim i As Long, j As Long, k As Long
    Dim lCountOfRows As Long
    Dim sThisAddress As String
    Dim aFieldsToKeep As Variant
    Dim wksData As Excel.Worksheet
    Dim wksTemp As Excel.Worksheet
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    'Zero based array, first field is the unique ID (email address)
    aFieldsToKeep = Array(2, 3, 4, 5, 8, 9, 10, 11, 12, 13, 14, 15, 17)
    
    'Assume worksheet with data is active when code starts; and sorted on email addresses
    Set wksData = ActiveSheet
    
    'Setup temporary sheet with data table columns to include in email body;
    'and also field 2 the field with unique ID (email address)
    Set wksTemp = Worksheets.Add
    For i = LBound(aFieldsToKeep) To UBound(aFieldsToKeep)
        j = j + 1
        Range("Email_Table").Columns(aFieldsToKeep(i)).Copy wksTemp.Cells(1, j)
    Next i
    wksTemp.Columns.AutoFit
    
    sThisAddress = wksTemp.Range("A2").Value
    k = 1
    'Loop through for each different name in field "A" and email data
    Do While Len(sThisAddress) > 0
        lCountOfRows = Application.WorksheetFunction.CountIf(wksTemp.Columns(1), sThisAddress)
        k = k + lCountOfRows
        
        Call SendRows(TheTable:=wksTemp.Range("A1").CurrentRegion.Offset(, 1).Resize(lCountOfRows + 1, UBound(aFieldsToKeep)), _
            SendTo:=sThisAddress, MsgSubject:=wksData.Range("B1").Value2, _
            MsgIntro:="hi, " & Range("Email_Table").Cells(k, 1) & "<br><br>" & wksData.Range("B2").Value2 & "<br><br>")
            
        wksTemp.Rows(2).Resize(lCountOfRows).Delete
        sThisAddress = wksTemp.Range("A2").Value
    Loop
    
    Application.DisplayAlerts = False
    wksTemp.Delete
    Application.DisplayAlerts = True
    Set wksTemp = Nothing
    Set wksData = Nothing
    Application.EnableEvents = True
    
End Sub


Sub SendRows(ByRef TheTable As Excel.Range, ByVal SendTo As String, ByVal MsgSubject As String, ByVal MsgIntro As String)
    
    Dim OutApp As Object
    Dim OutMail As Object
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        .To = SendTo
        .CC = vbNullString
        .BCC = vbNullString
        .Subject = MsgSubject
        .HTMLBody = MsgIntro & RangetoHTML(TheTable)
        .Save
        .Close 0
    End With
    On Error GoTo 0


cleanup:
    Set OutMail = Nothing
    Set OutApp = Nothing


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
 
Upvote 0
Wow, I can't thank you enough for taking your time to put this together. I seriously need to start studying VBA again.

Though, I am seeing just two parts that seem to be missing/off. Do you think it would be much trouble to tweak for the below?

1) The below is what is drafted for George, but you can see this includes Amanda's line as well. This happened for the other e-mail addresses, one more mentioned below.

2) The headers are not copied into the e-mail address. It actually looks like this and No. 1 are related, looks like Amanda's line is acting as the header.



hi, George

The below item(s) are outstanding within MITC. If these are already resolved, then please ignore this e-mail. Also, please let me know if you need assistance with this.

[TABLE="width: 907"]
[TR]
[TD]Apple, Amanda
[/TD]
[TD]Smith, John
[/TD]
[TD]Hourly
[/TD]
[TD]600
[/TD]
[TD]009012
[/TD]
[TD]Accounting
[/TD]
[TD][/TD]
[TD][/TD]
[TD]2/6/2019
[/TD]
[TD]12:04:26
[/TD]
[TD][/TD]
[TD]Call In Missing or Not Approved
[/TD]
[/TR]
[TR]
[TD]Curry, George
[/TD]
[TD]Salem, Travis
[/TD]
[TD]Hourly
[/TD]
[TD]301
[/TD]
[TD]002600
[/TD]
[TD]Warehouse
[/TD]
[TD]2/11/2019
[/TD]
[TD]13:21:38
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Call Out Missing or Not Approved
[/TD]
[/TR]
[TR]
[TD]Curry, George
[/TD]
[TD]Salem, Travis
[/TD]
[TD]Hourly
[/TD]
[TD]102
[/TD]
[TD]009102
[/TD]
[TD]Warehouse
[/TD]
[TD]2/12/2019
[/TD]
[TD]13:16:32
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Call Out Missing or Not Approved
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[/TABLE]


hi, Michelle

The below item(s) are outstanding within MITC. If these are already resolved, then please ignore this e-mail. Also, please let me know if you need assistance with this.

[TABLE="width: 907"]
[TR]
[TD]Apple, Amanda
[/TD]
[TD]Smith, John
[/TD]
[TD]Hourly
[/TD]
[TD]600
[/TD]
[TD]009012
[/TD]
[TD]Accounting
[/TD]
[TD][/TD]
[TD][/TD]
[TD]2/6/2019
[/TD]
[TD]12:04:26
[/TD]
[TD][/TD]
[TD]Call In Missing or Not Approved
[/TD]
[/TR]
[TR]
[TD]Miller, Michelle
[/TD]
[TD]Russell, Corey
[/TD]
[TD]Hourly
[/TD]
[TD]102
[/TD]
[TD]009102
[/TD]
[TD]Warehouse
[/TD]
[TD]2/12/2019
[/TD]
[TD]12:33:04
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Call Out Missing or Not Approved
[/TD]
[/TR]
[TR]
[TD]Miller, Michelle
[/TD]
[TD]Russell, Corey
[/TD]
[TD]Salary
[/TD]
[TD]311
[/TD]
[TD]002802
[/TD]
[TD]House
[/TD]
[TD][/TD]
[TD][/TD]
[TD]2/12/2019
[/TD]
[TD]10:15:01
[/TD]
[TD][/TD]
[TD]Call In Missing or Not Approved
[/TD]
[/TR]
[TR]
[TD]Miller, Michelle
[/TD]
[TD]Smith, Sean
[/TD]
[TD]Salary
[/TD]
[TD]311
[/TD]
[TD]002802
[/TD]
[TD]House
[/TD]
[TD][/TD]
[TD][/TD]
[TD]2/12/2019
[/TD]
[TD]10:15:01
[/TD]
[TD][/TD]
[TD]Call In Missing or Not Approved
[/TD]
[/TR]
[TR]
[TD]Miller, Michelle
[/TD]
[TD]Tompkins, Brian
[/TD]
[TD]Salary
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]2/12/2019
[/TD]
[TD]Calendar Request Pending Approval
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[/TABLE]
 
Upvote 0
Verbiage Correction: Didn't meant to say e-mail 'addresses' below, only 'e-mails'.

1) The below is what is drafted for George, but you can see this includes Amanda's line as well. This happened for the other e-mails, one more mentioned below.

2) The headers are not copied into the e-mails. It actually looks like this and No. 1 are related, looks like Amanda's line is acting as the header.
 
Last edited:
Upvote 0
Initial thought - unchecked but fits the description? - is the set up is not what I expected. Check that "Email_Table" range matches the table range - that is headers & data.
 
Upvote 0
Will do Fazza. Thanks again for your help, much appreciated. Looks like I need to start studying the good ol' VBA again, b/c it sure would help to have that knowledge when things like this come up. See ya around.
 
Upvote 0
Hey Fazza,

Been really doing my best to wrap my head around this. Was really hoping you could just kind of explain the below. Now, I get what it's doing, however my question is specifically about the Array portion... when i msgbox the array it shows 0, 1, 2, 3... but below you put 2, 3, 4, 5, etc... and it populates correctly... how is this so? If the msgbox shows 0, how is it pulling 2?

aFieldsToKeep = Array(2, 3, 4, 5, 8, 9, 10, 11, 12, 13, 14, 15, 17)

For i = LBound(aFieldsToKeep) To UBound(aFieldsToKeep)
j = j + 1
Range("Email_Table").Columns(aFieldsToKeep(i)).Copy wksTemp.Cells(1, j)
Next i
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,224,820
Messages
6,181,159
Members
453,021
Latest member
Justyna P

Share this page

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
Back
Top