JorgeMartinez
New Member
- Joined
- Mar 2, 2016
- Messages
- 10
- Office Version
- 365
- Platform
- 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.
Here is the script that creates the email. No errors:
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
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:
I would summarize my doubts as follows:
Any feedback would be highly appreciated.
Thanks in advance.
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.
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 SubHere 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 SubI 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 SubI would summarize my doubts as follows:
- Should I keep these two scripst separated? I feel the code within the Loop would be enormous and I assume would affect the speed.
- 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.
- 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.
Any feedback would be highly appreciated.
Thanks in advance.
