Hello All,
I am hoping this will be an easy one for you experienced coders.
I am a bit of noob, but have managed to compile the following code from various sources:
The code email's out a PDF of Excel Sheet via Outlook, but I would like to change the ".To" and ".CC" sections to a pull from a list located in a sheet from a different excel workbook located in a different folder.
I was informed recently that I need to add this email code to another users workbooks, but then I found out that he has 1 workbook setup for each day of the month, for all 12 months, therefore any changes to emails address will be time consuming.
I would like to use a separate workbook to manage the email distribution list, this way I just change the addresses in 2 columns, 1 for To, 1 for CC, and my pain goes away. Would appreciate any help on this.
I am hoping this will be an easy one for you experienced coders.
I am a bit of noob, but have managed to compile the following code from various sources:
The code email's out a PDF of Excel Sheet via Outlook, but I would like to change the ".To" and ".CC" sections to a pull from a list located in a sheet from a different excel workbook located in a different folder.
I was informed recently that I need to add this email code to another users workbooks, but then I found out that he has 1 workbook setup for each day of the month, for all 12 months, therefore any changes to emails address will be time consuming.
I would like to use a separate workbook to manage the email distribution list, this way I just change the addresses in 2 columns, 1 for To, 1 for CC, and my pain goes away. Would appreciate any help on this.
VBA Code:
Sub Email_Click()
Dim IsCreated As Boolean
Dim i As Long, DesktopPath As String
Dim PdfFile As String, Title As String
Dim OutlApp As Object
' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
' Enter Subject / Title for email below:
Title = "Recap for " & Range("M2").Value
' Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Subject = Title
.To = "user@test.com; user2@test.com; user3@test.com " ' <-- This needs to change to a different workbook, located in a different folder / path
.CC = "user4@test2.com; user5@test.com" ' <--This needs to change to a different workbook, located in a different folder, same as above, but different column
.Body = "Hi," & vbLf & vbLf _
& "The Recap for today's shift is attached in PDF format, open to view." & vbLf & vbLf _
& "This auto generated email was generated by the following user account:" & vbLf & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile
' Try to send or Display
On Error Resume Next
.Display
'.Send
Application.Visible = True
'If Err Then
' MsgBox "E-mail was not sent", vbExclamation
'Else
' MsgBox "E-mail successfully sent", vbInformation
' End If
On Error GoTo 0
End With
' Delete PDF file
Kill PdfFile
' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit
' Release the memory of object variable
Set OutlApp = Nothing
End Sub