I'm sure there's more than one way to accomplish this, but here's a script that I use in one of my workbooks to email receipts to people (this list is from line 6-107...can be changed to suit your sheet). Overall, you should be able to massage it to meet your needs. In my workbook I have a tab that details the smtp address, sendfrom address, password, print area, etc. all set up with named ranges rather than hardcoding those details into the script. NOTE: If you are using a gmail account to send from, you'll have to go into that account and change your security settings to allow "less secure" apps to send mail on your behalf. You'll also see that there is a built in delay. This is to allow each email to send rather than hanging up the system with too many emails going out too quickly.
Sub CDO_Receipt()
Application.DisplayAlerts = False
' Create PDF of active sheet and send as attachment.
'
Dim strPath As String, strFName As String
Dim LineNo As Integer
Dim EmailLine As Integer
Dim OutApp As Object, OutMail As Object
Dim ws As Worksheet
Dim wp As Worksheet
Dim wConfig As Worksheet
Set ws = ThisWorkbook.Sheets("BatchReceipts")
Set wp = ThisWorkbook.Sheets("Attendance")
Set wConfig = ThisWorkbook.Sheets("Config")
ws.PageSetup.PrintArea = ws.Range("Print_Area").Address
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
strPath = "c:\windows\temp\" 'Or any other path, but include trailing "\"
wp.Range("Row_Index").Value = 6
'Insert Do While around this section?
Do
'Create PDF of active sheet only
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("
http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("
http://schemas.microsoft.com/cdo/configuration/smtpserver") _
= wConfig.Range("SMTP_Server").Text
.Item("
http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("
http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("
http://schemas.microsoft.com/cdo/configuration/sendusername") = wConfig.Range("Auth_Name").Text
.Item("
http://schemas.microsoft.com/cdo/configuration/sendpassword") = wConfig.Range("Auth_Password").Text
.Update
End With
strbody = wConfig.Range("Body_Text").Text
'Create PDF of active sheet only
If wp.Cells(wp.Range("Row_Index").Value, 2).Text <> "" Then
strFName = "EventReceipt.pdf"
Dim Start As Single
Start = Timer
'wait x sec...
Do While Start + wConfig.Range("Cycle_Delay").Value > Timer
DoEvents
Loop
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPath & strFName, IgnorePrintAreas:=False, OpenAfterPublish:=False
With iMsg
Set .Configuration = iConf
' .To = ThisWorkbook.Sheets("Receipts").Range(B & LineNo).Value
.To = wp.Cells(wp.Range("Row_Index").Value, 2).Text
.CC = ""
.BCC = wConfig.Range("BCC_Addr").Text
.From = wConfig.Range("Auth_Name").Text
.Subject = wConfig.Range("Subject_Text").Text
.TextBody = strbody
.AddAttachment strPath & strFName
.Send
End With
End If
wp.Range("Row_Index").Value = wp.Range("Row_Index").Value + 1
Loop While wp.Range("Row_Index").Value < 107
Application.DisplayAlerts = True
MsgBox ("Batch Complete")
End Sub