VBA Macro - How to send a single email to recipients showing one or more times in an excel table

AndreMateus

New Member
Joined
Mar 31, 2023
Messages
11
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have a script (see below) that will generate an email from my secondary mailbox and copy a filtered range from a table and place a copy of the filtered table in the body of the email (the copied range is changed manually on the table before running the macro).
This code is not adding the filtered email address to the "to" field of the outlook email and it is also not listing the attachment that need to be sent to the correct recipient(s).

Basically, what I would like to see is that when manually filtering the table based on "requestor" or "email", the attachments listed in the active workbook (column G" should be added to the outlook email along with the 2 fixed documents that must always be added as atatchment.

Here's the current code:

Sub Soft_Token_Distribution()
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Dim path As String


Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)


With newEmail

.To = Sheet4.Range("L2").Text ' this line here needs to add the email address from the filtered active table of our recipient
.CC = ""
.BCC = ""
.Subject = "SOW Contingent Worker - Remote Access Request"
.HTMLBody = "Hi, <br/><br/> As part of your <b> Create, Modify or Terminate SOW Contingent Worker </b> ServiceNow request for the below user, you requested Remote Access for the user. <br/><br/> Vendor Remote Access has been provisioned for this user. Please share the attached documents with the user so that they can configure their Vendor Remote Access. <br/><br/> Regards,"

.attachments.Add "C:\Instructions.pdf"
.attachments.Add "C:\PIN Mode.pdf"
.attachments.Add "C:\RemoteAMBA\bin\SoftTokens\" & Range("g2").Value ' this line here needs to add all attachments listed in the active table for the current recipient only



Set .SendUsingAccount = outlook.Session.Accounts.Item(2)

.Display
Set xInspect = newEmail.GetInspector
Set pageEditor = xInspect.WordEditor

Sheet4.Range("Table2[#All]").Copy

pageEditor.Application.Selection.Start = 316
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)

.Display
'.Send
Set pageEditor = Nothing
Set xInspect = Nothing
End With
Set newEmail = Nothing
Set outlook = Nothing
End Sub





SOW Contingent Worker - Work in Progress (003).xlsm
BCDEFGHIJKL
1OpenedWorker First NameWorker Last NameContract Start DateIDSoft Token File NameCost CenterDomainRemote AccessRequestorEmail
23/29/2023First_Name_1Last_Name_12023-04-12ID_1ID_1_000123456789.sdtid3638TDBFGYesAndre MateusAndre.Mateus@test.com
33/29/2023First_Name_2Last_Name_22023-04-03ID_2ID_2_000123456789.sdtid7983TDBFGYesAndre MateusAndre.Mateus@test.com
43/27/2023First_Name_3Last_Name_32023-03-24ID_3ID_3_000123456789.sdtid9947TDBFGYesAndre MateusAndre.Mateus@test.com
53/29/2023First_Name_4Last_Name_42023-04-11ID_4ID_4_000123456789.sdtid6084TDBFGYesAndre MateusAndre.Mateus@test.com
63/29/2023First_Name_5Last_Name_52023-04-03ID_5ID_5_000123456789.sdtid3510TDBFGYesJohn DoeJohn.Doe@test.com
73/29/2023First_Name_6Last_Name_62023-04-13ID_6ID_6_000123456789.sdtid3930TDBFGYesJohn DoeJohn.Doe@test.com
83/29/2023First_Name_7Last_Name_72023-02-02ID_7ID_7_000123456789.sdtid9754TDBFGYesJohn DoeJohn.Doe@test.com
93/27/2023First_Name_8Last_Name_82023-03-24ID_8ID_8_000123456789.sdtid9120TDBFGYesJohn DoeJohn.Doe@test.com
103/29/2023First_Name_9Last_Name_92023-04-06ID_9ID_9_000123456789.sdtid3638TDBFGYesMr CleanMr.Clean@test.com
113/29/2023First_Name_10Last_Name_102023-04-15ID_10ID_10_000123456789.sdtid7983TDBFGYesMr CleanMr.Clean@test.com
Token Distribution




Please see photo to check how the output should look like after manually filtering the table by email or requestor name.
 

Attachments

  • Outpul email 1.JPG
    Outpul email 1.JPG
    139.5 KB · Views: 16
  • filter table first receipt.JPG
    filter table first receipt.JPG
    112.9 KB · Views: 16
  • filter table second recipient.JPG
    filter table second recipient.JPG
    111.7 KB · Views: 18
  • second email.JPG
    second email.JPG
    134.7 KB · Views: 17

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

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