this is a bastardized version of Shrivallabha's code posted here:
http://www.vbaexpress.com/forum/showthread.php?t=35917
I'm trying to send a bunch of emails but customize the message with information from the spreadsheet (customer name, machine type, serial, etc.) and its just not really happening at all, not throwing any errors just not working:
[VBA]Sub emailer()
Dim nSess As Object
Dim nDir As Object
Dim nDb As Object
Dim nDoc As Object
Dim nAtt As Object
Dim vToList As Variant, vCCList As Variant, vBody As Variant
Dim vbAtt As VbMsgBoxResult
Dim sFilPath As String
Dim sPwd As String
Dim cell As Range
Dim r As Long
Dim lr As Long
sPwd = Application.InputBox("Type your Lotus Notes password!", Type:=2)
Set nSess = CreateObject("Lotus.NotesSession")
Call nSess.Initialize(sPwd)
ActiveWorkbook.Sheets(1).Activate
lr = Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Range("M2:M" & lr)
r = cell.Row
Set nDir = nSess.GetDbDirectory("")
Set nDb = nDir.OpenMailDatabase
Set nDoc = nDb.CreateDocument
vToList = Range("M" & r).Text
vCCList = ""
With nDoc
Set nAtt = .CreateRichTextItem("Body")
Call .ReplaceItemValue("Form", "Memo")
Call .ReplaceItemValue("Subject", "June Meter Reads " & Range("D" & r).Text & " - " & Range("B" & r).Text)
With nAtt
.AppendText ("This is a friendly reminder that the meter reading for your equipment is due for the following machine:" & _
vbCrLf & vbCrLf & "Machine Type - " & Range("H" & r).Text & vbCrLf & "Serial - " & Range("J" & r).Text & _
vbCrLf & vbCrLf & "Previous Meter Read - " & Range("W" & r).Text & vbCrLf & "Current Meter Read - " & Range("Y" & r) & _
vbCrLf & vbCrLf & "Please respond to this email with your meter read to ensure accurate and timely billing." & _
vbCrLf & vbCrLf & "Thank you for your assistance and for choosing RPPS, formerly operating as InfoPrint." & _
vbCrLf & vbCrLf & "Ricoh Production Print Services (RPPS)" & vbCrLf & "usage_us@infoprint.com")
End With
Call .ReplaceItemValue("CopyTo", vCCList)
Call .ReplaceItemValue("PostedDate", Now())
Call .Send(False, vToList)
End With
Next cell
End Sub
[/VBA]
Reply With Quote