Hi,
I am trying to send an email to a list of address from a sheet. I had this working with just placing the email address directing in the .TO = "john1@email.com" ; "john2@email.com", but when I attempt to use a list from a worksheet, I can not get this to work.
I receive an error here:
"Object doesn't support this property or method"
.To = ws.Range("A" & i).Value
Are you able to tell what I am missing in the code below?
Thank you kindly!
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, OutlMail As Object
Dim ws As Worksheet ' Added for Email Address List
Dim lRow As Long 'Added for Email Address List
' 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
' Reference Email sheet
Set ws = ThisWorkbook.Sheets("Email")
'Check columns, and pull names from all rows.
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 1 To lRow
Set OutlMail = OutlApp.CreateItem(0)
' Prepare e-mail with PDF attachment
With OutlApp
' Prepare e-mail
.To = ws.Range("A" & i).Value
.CC = ws.Range("E" & i).Value
.Subject = Title
.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
Next i
End With
End Sub
