Sending Email to List located in different workbook?

[seekon]

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.

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

 

[Yard]

Why not just use an Excel method to bring the list into this workbook, and then use it? Possibly easier to use and maintain than having VBA go and find the right book?

 

[seekon]

Hi Yard,

I assume you mean to populate a sheet in this workbook with links to another work and then use this sheet columns to reference in VBA?

If so, are you able to assist with the code that reference the columns in this sheet. I have forgot the code, it's been a while and I still consider myself a bit of newbie...

Much appreciated!

 

[Yard]

Hi, assuming your email addresses are in two ranges (EmailToList and EmailCCList) on a worksheet (Email addresses), then this code would build the two strings that you can then use in the .To and .CC lines of your code:

Dim strEmailTo As String, strEmailCC As String
Dim rngEmailTo As Range, rngEmailCC As Range, rngCell As Range
Const strDelim As String = "; "

Set rngEmailTo = Worksheets("Email addresses").Range("EmailToList")
Set rngEmailCC = Worksheets("Email addresses").Range("EmailCCList")

For Each rngCell In rngEmailTo.Cells
    strEmailTo = strEmailTo & rngCell.Value & strDelim
Next rngCell

For Each rngCell In rngEmailCC.Cells
    strEmailCC = strEmailCC & rngCell.Value & strDelim
Next rngCell