Excel Macro to Email String of Lotus Notes

[jtwusmc]

I have been working on a macro to email a string of email address through Lotus notes. I have been having luck with the following macro as this is emailing the first person, but still have a few quirks...

The code is only emailing the first person and I need it to send seperate emails to a string of separate email address. The emails are all in column AF, but each email address is 23 rows down from the next starting from row 6... The code is also getting the subject and message info from adjoining columns that are 23 rows apart each.

Any advise?

Sub SendNotesMail()
Dim Email As String, Subj As String, Msg As String
Dim r As Integer, x As Double
Dim Maildb As Object, UserName As String, MailDbName As String, DomDbName As String
Dim stFileName As String
Dim MailDoc As Object, Session As Object
 
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = "mail\" & Mid$(UserName, 4, InStr(1, UserName, " ") - 4) & Mid$(UserName, _
    InStr(1, UserName, " ") + 1, InStr(1, UserName, "/") - InStr(1, UserName, " ") - 1) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
    Else: Maildb.OPENMAIL
End If
For r = 1 To Range("af1").End(xlDown).Row
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
Email = Cells(r, 1)
Subj = Cells(r, 6)
 Msg = ""
        Msg = Msg & Range("ak" & r) & "," & vbCrLf & vbCrLf
        Msg = Msg & Range("ai" & r) & "." & vbCrLf & vbCrLf
        Msg = Msg & "Thank you," & vbCrLf
        Msg = Msg & "John Doe"
MailDoc.sendto = Email
'MailDoc.CopyTo = Whomever
'MailDoc.BlindCopyTo = Whomever
MailDoc.Subject = Subj
MailDoc.Body = Msg
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now
'Wait two seconds before sending keystrokes
        'Application.Wait (Now + TimeValue("0:00:02"))
        'Application.SendKeys "%s"
On Error GoTo Audi
Call MailDoc.Send(False)
Next r
Set Maildb = Nothing:    Set MailDoc = Nothing:    Set Session = Nothing
Exit Sub
Audi:
Set Maildb = Nothing:    Set MailDoc = Nothing:    Set Session = Nothing
End Sub

Thank you!

 

[jtwusmc]

I figured out what I needed on the question above. One other question though. I think it is an easy one... Below is the code I wrote that is now working. Only think is that I need it to not send the emails. I like to review each email for accuracy and hit send myself...

Sub SendNotesMail()
Dim Email As String, Subj As String, Msg As String
Dim r As Integer, x As Double
Dim Maildb As Object, UserName As String, MailDbName As String, DomDbName As String
Dim stFileName As String
Dim MailDoc As Object, Session As Object
 
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = "mail\" & Mid$(UserName, 4, InStr(1, UserName, " ") - 4) & Mid$(UserName, _
    InStr(1, UserName, " ") + 1, InStr(1, UserName, "/") - InStr(1, UserName, " ") - 1) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
    Else: Maildb.OPENMAIL
End If
    For r = 6 To Range("AF65536").End(xlUp).Row
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
Email = Range("af" & r)
Subj = Range("aj" & r)
 Msg = ""
        Msg = Msg & Range("ak" & r) & "," & vbCrLf & vbCrLf
        Msg = Msg & Range("ai" & r) & "." & vbCrLf & vbCrLf
        Msg = Msg & "Thank you," & vbCrLf
        Msg = Msg & "John Walsh"
MailDoc.sendto = Email
'MailDoc.CopyTo = Whomever
'MailDoc.BlindCopyTo = Whomever
MailDoc.Subject = Subj
MailDoc.Body = Msg
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now
'Wait two seconds before sending keystrokes
        'Application.Wait (Now + TimeValue("0:00:02"))
        'Application.SendKeys "%s"
        
                'increment for the next person
        r = r + 23
On Error GoTo Error_Handling
Call MailDoc.Send(False)
Next r
Set Maildb = Nothing:    Set MailDoc = Nothing:    Set Session = Nothing
Exit Sub
Error_Handling:
Set Maildb = Nothing:    Set MailDoc = Nothing:    Set Session = Nothing
End Sub