Emailing my Spreadsheet using a list of email addresses on a separate spreadsheet file

[pinkpanther6666]

I have to email my spreadsheet twice daily to about 50 people
currently this is done with a list of email addresses at are built into the VBA code of the spreadsheet
How can i email my spreadsheet out using a list of email address that are in a separate spreadsheet file as the list of names change daily/Weekly


Many Thanks in advance


Steve

 

[PureBluff]

This should do what you want, I believe

If you wish to reference a different workbook, then I believe it needs to be open (or VBA to open/close it)

Sub SendEmail()

    Dim OutApp, OutMail As Object
    Dim RecipientsRange, RecipientCell As Range
    Dim FilePath As String
    Dim LastRow as Long
  
    ' Set the file path of the spreadsheet to be attached
    FilePath = "C:\Users\PureBluff\Documents\workbook_name.xlsx"
  
    ' Set the last row of the email list/column
    With Sheets("Config")
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With

    ' Create a reference to the "Configuration" worksheet - This is assumed the mailing list is in the same workbook.
    'This is a dynamic range assuming there are no gaps in the list.
    Set RecipientsRange = ThisWorkbook.Worksheets("Config").Range("B3:B" & LastRow)
  
    ' Create a new Outlook instance
    Set OutApp = CreateObject("Outlook.Application")

  
    ' Loop through each recipient in the range and send an email
    For Each RecipientCell In RecipientsRange
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            ' Add recipient's email address
            .To = RecipientCell.Value
          
            ' Set email subject and body
            .Subject = "Email Subject"
            .Body = "Hello, This is the email body."
          
            ' Attach the spreadsheet
            .Attachments.Add FilePath
          
            ' Send the email
            .Send
            'Or use:
            '.Display


        End With
    Next RecipientCell
  
    ' Release the Outlook objects
    Set OutMail = Nothing
    Set OutApp = Nothing


End Sub