Hi everyone,
I'm an apprentice in Finance. My manager needs to automate the email process.
What I'm asked to do:
- Generate emails personalised to each receiver (DONE)
- Attach the adequate file to each mail (DONE)
- A table/screenshot of the most important financial KPI in the email body (Don't know how to)
I have 2 ideas but don't know how to code them
1 - Make VBA search in the files attached the KPI (turnover/margin and EBITDA) and take a screen and project it in the mail body for each mail
2 - Create a table in Excel with changeable values of all the agencies using functions and VBA only takes a screen or the table itself of the concerned agencies and send them to the right people
(In my Excel Sheet, there are the names of the destinator, their emails, the message of the mail and the link to the attachment)
THANK YOU SO MUCH ! I really need any help I can get
Here is the code so far:
Sub Send_Files()
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("ESSAI 2")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
.To = cell.Value
.Subject = Range("B11") & Range("H13") & " - " & cell.Offset(0, 2)
.HTMLBody = "Bonjour " & cell.Offset(0, -1).Value & "," & "<p>" & "<\p>" & Range("B15") & " " & Range("C15") & " " & Range("D15") & "<p>" & Range("B16") & "<p>" & "<\p>" & Range("B17") & .HTMLBody
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
I'm an apprentice in Finance. My manager needs to automate the email process.
What I'm asked to do:
- Generate emails personalised to each receiver (DONE)
- Attach the adequate file to each mail (DONE)
- A table/screenshot of the most important financial KPI in the email body (Don't know how to)
I have 2 ideas but don't know how to code them
1 - Make VBA search in the files attached the KPI (turnover/margin and EBITDA) and take a screen and project it in the mail body for each mail
2 - Create a table in Excel with changeable values of all the agencies using functions and VBA only takes a screen or the table itself of the concerned agencies and send them to the right people
(In my Excel Sheet, there are the names of the destinator, their emails, the message of the mail and the link to the attachment)
THANK YOU SO MUCH ! I really need any help I can get
Here is the code so far:
Sub Send_Files()
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("ESSAI 2")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
.To = cell.Value
.Subject = Range("B11") & Range("H13") & " - " & cell.Offset(0, 2)
.HTMLBody = "Bonjour " & cell.Offset(0, -1).Value & "," & "<p>" & "<\p>" & Range("B15") & " " & Range("C15") & " " & Range("D15") & "<p>" & Range("B16") & "<p>" & "<\p>" & Range("B17") & .HTMLBody
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub