How can I unite these two scripts to send emails with single or multiple attachments to a list of contacts?

JorgeMartinez

New Member
Joined
Mar 2, 2016
Messages
10
Office Version
  1. 365
Platform
  1. Windows
Hi all,

The goal of the script is to display an email containing one or more attachments and a screenshot of the details of such attachments for each one of the clients within a column. The attachments tend to be Invoices and a single customer may have one or multiple.

As of now, I have the script which will go within the Loop created. This script creates the email based on the information within the Workbook, add the print screen in the body and an attachment.

I am right now looking to create the loop which will go through each of the customers in the column and perform the above mentioned action.

This is how the sheet looks. As you can notice I have 2 different clients with different amount of documents generated
Here is the script that creates the email. No errors:

VBA Code:
Public Sub HermesTheSender()

' Make all the Dims
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
Dim rng As Range
Dim lRow As Long, lCol As Long
Dim StrBody As String

'Select the signature to use
SigString = Environ("appdata") & _
"\Microsoft\Signatures\" & Cells(2, 7).Text & ".htm"

If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
Else
Signature = ""
End If

On Error Resume Next
   
' Set the abbreviations
Set ws = Excel.ThisWorkbook.Worksheets("Hermes")
StrBody = Sheets("Hermes").Range("C5").Value
filePath = ws.Cells(5, 1)
Subject = ws.Cells(2, 5)

i = 9

'Select the appropriate range to copy and paste into the body of the email
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("Hermes").Range("A8:M" & Range("A8:M8").End(xlDown).Row).SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not valid." & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

'Create email
With OutMail
.Subject = Cells(i, 19).Text & "- " & Subject & Date
.To = Cells(i, 15).Value
.CC = Cells(i, 16).Value
.Bcc = Cells(i, 17).Value
.Importance = 2
.Attachments.Add filePath & "\" & Cells(i, 4) & ".pdf"
.HTMLBody = StrBody & RangetoHTML(rng) & "<br>" & Signature
.SentOnBehalfOfName = Sheets("Hermes").Cells(2, 3).Text
            .Display
End With

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Here is the code I will guide myself with to sort through each one of the clients in column C. Found in this answer:
VBA to loop among filter criteria in a specific column

VBA Code:
Public Sub Print_Drivers()

Dim DriversDict As Object, Drivers As Variant, i As Long, Driver As Variant
   
Set DriversDict = CreateObject("Scripting.Dictionary")
   
'The code looks at data on the active sheet
   
With ActiveSheet

'Show AutoFilter if not already and all rows
       
If Not .AutoFilterMode Then .UsedRange.AutoFilter
If .Cells.AutoFilter Then .Cells.AutoFilter
   
'Create list of unique Drivers in column B
       
Drivers = Range(.Range("B2"), .Cells(Rows.Count, "B").End(xlUp))
For i = 1 To UBound(Drivers, 1)
DriversDict(Drivers(i, 1)) = 1
Next
       
'For each unique Driver
       
For Each Driver In DriversDict.keys
           
'AutoFilter on column B with this Driver
           
.UsedRange.AutoFilter Field:=2, Criteria1:=Driver
           
'Print filtered data
           
.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Next
   
'Clear all filters
       
If .Cells.AutoFilter Then .Cells.AutoFilter
       
End With
   
End Sub

I tried to combine both codes and the script runs without doing perfmong any action. I am not able to spot the issue. My combination resulted in:

VBA Code:
Public Sub HermesTheSender()

' Make all the Dims
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
Dim rng As Range
Dim lRow As Long, lCol As Long
Dim StrBody As String

'Select the signature to use
SigString = Environ("appdata") & _
"\Microsoft\Signatures\" & Cells(2, 7).Text & ".htm"

If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
Else
Signature = ""
End If

On Error Resume Next
   
' Set the abbreviations
Set ws = Excel.ThisWorkbook.Worksheets("Hermes")
StrBody = Sheets("Hermes").Range("C5").Value
filePath = ws.Cells(5, 1)
Subject = ws.Cells(2, 5)
   
'Code for testing the Loop
Dim DriversDict As Object, Drivers As Variant, i As Long, Driver As Variant
Set DriversDict = CreateObject("Scripting.Dictionary")
   
'Show AutoFilter if not already in all rows
       
With ActiveSheet

If Not .AutoFilterMode Then .UsedRange.AutoFilter
If .Cells.AutoFilter Then .Cells.AutoFilter
   
'Create list of unique Drivers in column B. My header starts in C8, therefore my i should be 8 as well
       
Drivers = Range(.Range("C8"), .Cells(Rows.Count, "C").End(xlUp))
For i = 8 To UBound(Drivers, 3)
DriversDict(Drivers(i, 3)) = 1
Next

'For each unique Driver
       
For Each Driver In DriversDict.keys
           
'AutoFilter on column B with this Driver
           
.UsedRange.AutoFilter Field:=2, Criteria1:=Driver
           
'Here would go the email creation

'Select the appropriate range to copy and paste into the body of the email
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("Hermes").Range("A8:M" & Range("A8:M8").End(xlDown).Row).SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not valid." & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

'Create email
With OutMail
.Subject = Cells(i, 19).Text & "- " & Subject & Date
.To = Cells(i, 15).Value
.CC = Cells(i, 16).Value
.Bcc = Cells(i, 17).Value
.Importance = 2
.Attachments.Add filePath & "\" & Cells(i, 4) & ".pdf"
.HTMLBody = StrBody & RangetoHTML(rng) & "<br>" & Signature
.SentOnBehalfOfName = Sheets("Hermes").Cells(2, 3).Text
            .Display
End With

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Next
   
'Clear all filters
       
If .Cells.AutoFilter Then .Cells.AutoFilter
       
End With

End Sub

I would summarize my doubts as follows:
  1. Should I keep these two scripst separated? I feel the code within the Loop would be enormous and I assume would affect the speed.
  2. I edited the script taken from the post in MrExcel and tried to adapt it to my needs. I need the filter on the Line 8 and Row 3 but it is not being applied at the moment.
  3. Is there a way I can make the script validate if there is more than one line for the customer and then get all the attachments in a single email? I.E.: For Client 1, having the 3 attachments; Client 2, 2 attachments; and another client with a single line, and email with a single attachment.
At the point I am in learning about VBA I am able to understand what I need to do and how I should do it. However, I am not yet so dexterous as to write my own code and make the proper adjustments.

Any feedback would be highly appreciated.

Thanks in advance.
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

vw412

Active Member
Joined
Dec 16, 2011
Messages
313
Office Version
  1. 2019
  2. 2016
  3. 2010
  4. 2007
Platform
  1. Windows
I have been looking at this and the previous question from 2017. I see that the previous question didn't get fully answered. Is it working as you need it to? If so, I assume that it ultimately generates the invoices needed to attach to the email you want to generate here. Is this a valid assumption?

Is the sheet shown in this thread original post the result of the processing of the worksheet from the old thread? I am not sure how to help at this time but what I think you want to do is similar to what I have done previously. I will be glad to help and coach you through some of the VBA to make it happen.
 

JorgeMartinez

New Member
Joined
Mar 2, 2016
Messages
10
Office Version
  1. 365
Platform
  1. Windows
Hi. Yes, it was not fully answered but I thought it would be good starting point. I can not understand the Ubound Line in that script.
That script per se does not work for me.

The one I wrote does. Creates an email with the attachment.

No, the sheet shown is the one from which the script that generates the email takes the information. Is this sheet the variable data would be the information from A9:M9 to the last row in the range.

I would appreciate your advise. Let me know how to reach out.
I have been looking at this and the previous question from 2017. I see that the previous question didn't get fully answered. Is it working as you need it to? If so, I assume that it ultimately generates the invoices needed to attach to the email you want to generate here. Is this a valid assumption?

Is the sheet shown in this thread original post the result of the processing of the worksheet from the old thread? I am not sure how to help at this time but what I think you want to do is similar to what I have done previously. I will be glad to help and coach you through some of the VBA to make it happen.
 

vw412

Active Member
Joined
Dec 16, 2011
Messages
313
Office Version
  1. 2019
  2. 2016
  3. 2010
  4. 2007
Platform
  1. Windows
I would like to help but I am having a hard time following the logic of this project. I think if you could upload (attach) a workbook that shows a representable sample of the data you start with and then a good example of the ouput you want to achieve I might be able to coach you along.
 

JorgeMartinez

New Member
Joined
Mar 2, 2016
Messages
10
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

I would like to help but I am having a hard time following the logic of this project. I think if you could upload (attach) a workbook that shows a representable sample of the data you start with and then a good example of the ouput you want to achieve I might be able to coach you along.
Surething. Don't really now how to edit the question or how to attach the file here. Could you point it out?
 

vw412

Active Member
Joined
Dec 16, 2011
Messages
313
Office Version
  1. 2019
  2. 2016
  3. 2010
  4. 2007
Platform
  1. Windows
I have done the upload myself recently but below the reply edit box is a button that says "Upload Mini-sheet". I would try that first.
 

JorgeMartinez

New Member
Joined
Mar 2, 2016
Messages
10
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

I have done the upload myself recently but below the reply edit box is a button that says "Upload Mini-sheet". I would try that first.
Book1.xlsx
ABCDEFGHIJKLM
1Save BySend Using AccountEmail SubjectSignature
2Sales Doc.someaccount@gmail.comNew Invoices Generated Jorge 1
3
4File PathMessesge Body
5C:\Users\UserName\DesktopDear Customer, blah blah
6
7
8Created BySTShip To Customer NameSales Doc.PO NumberBill.Doc.Billing Doc Created OnShipment ETACNDSVFANSeal Num 1OMRN
9UserNameValue 1CLIENT 111111111111107/04/202105.05.20211111NAMENAMENUMBERNAME
10UserNameValue 1CLIENT 122222222222207/04/202105.05.20212222NAMENAMENUMBERNAME
11UserNameValue 1CLIENT 133333333333307/04/202105.05.20213333NAMENAMENUMBERNAME
12UserNameValue 2CLIENT 244444444444407/04/202102.04.20214444NAMENAMENUMBERNAME
13UserNameValue 2CLIENT 2555555555555507/04/202104.04.20215555NAMENAMENUMBERNAME
Hermes
 

JorgeMartinez

New Member
Joined
Mar 2, 2016
Messages
10
Office Version
  1. 365
Platform
  1. Windows
I have done the upload myself recently but below the reply edit box is a button that says "Upload Mini-sheet". I would try that first.
Hope it makes more sense now. Thanks in advance for your time.
 

JorgeMartinez

New Member
Joined
Mar 2, 2016
Messages
10
Office Version
  1. 365
Platform
  1. Windows
I have done the upload myself recently but below the reply edit box is a button that says "Upload Mini-sheet". I would try that first.
To make it clear: I want to go through each value in the column Ship To Customer Name.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,593
Messages
5,637,294
Members
416,963
Latest member
zazama

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
Top