Help with e-mailing code

melody.anne

Registered User.
Local time
Yesterday, 22:08
Joined
Feb 27, 2015
Messages
43
I have this code that I want to work the following way: I have a list box, and I want the code to loop through the records, and populate the "send to" area of the e-mail.

Code:
Private Sub Command39_Click()
Dim MyDb As DAO.Database
Dim rsEmail As DAO.Recordset
Dim sToName As String
Dim sSubject As String
Dim sMessageBody As String
Dim Notesdb As Object
Dim NotesDoc As Object
Dim Notesrtf As Object
Dim NotesSession As Object
Set MyDb = CurrentDb()
Set rsEmail = MyDb.OpenRecordset("qryNames", dbOpenSnapshot)
 
With rsEmail
        Set NotesSession = CreateObject("Notes.NotesSession")
        Set Notesdb = NotesSession.GetDatabase("", "")
        Call Notesdb.OpenMail
        Rem make new mail message
        Set NotesDoc = Notesdb.CreateDocument
        
        .MoveFirst
        Do Until rsEmail.EOF
            If IsNull(.Fields(2)) = False Then             
                sToName = (.Fields(2) & ", ")
                On Error Resume Next
                               
                NotesDoc.SendTo = Split(sToName & ", ")                             
                NotesDoc.Subject = ("Reporte ")
                Set Notesrtf = NotesDoc.CreateRichTextItem("body")
                Call Notesrtf.appendtext("Report")
                Call Notesrtf.addnewline(2)
                Rem attach Error Report doc
                's = ActiveDocument.Path + "\" + ActiveDocument.Name
                Call Notesrtf.embedObject(1454, "", strCurrentPath, "Mail.rtf")
                Rem send message
                
                Call NotesDoc.Send(False)
                Set NotesSession = Nothing
        
            End If
            .MoveNext
        DoCmd.SendObject acSendReport, "rptName", acFormatPDF, sToName, , , sSubject
        Loop
End With
 
Set MyDb = Nothing
Set rsEmail = Nothing
End Sub

To my understanding, the "NotesDoc.SendTo" and "NotesDoc.Subject parts aren't doing anything at all.

This code does populate the "Send To" field, but it opens a new e-mail for each recipient rather than put them all in the same e-mail Send To field (e.g. "e-mail1", "e-mail2", "e-mail3", etc).

It also sends an e-mail to every single person in the e-mails table rather than the selected ones. I don't know what to do to fix this, and I've Googled for answers for hours. Any help is appreciated.
 
I'll try and help with what I can see of the code.

Not sure where the listbox comes in to this?

I would expect the Sendto field needs to be populated with the email address or addresses required. My understanding from what you have said so far is that you want all the email addresses in the send to field? So it is one email with attachments sent to multiple recipients.?

You have the Send of the email inside the loop, so you need to get all the email addresses concatentated together inside the loop and then when the loop ends then add attachments and anything else and send the email.

Re sending to all people in the email database, that is down to whatever the qryNames selects. That query should only retrieve the records for the addresses you wish to send the email to.?

So in essence you need to

Select all required records.
Loop through the recordset appending each name to the sToName.
When out of the loop you will end up with an extra "," at the end, so will need to remove that.
Add attachments and then send the email.

HTH, it should at least point you in the right direction.

Edit: What is the SendObject line of code meant to do as that is inside the loop as well.?
 
Last edited:
'Not sure where the listbox comes in to this?
The list box has the names of the people I can choose to send emails to, and from there I select.

So it is one email with attachments sent to multiple recipients.?
Yes, I want one e-mail with attachment sent to multiple recipients.

That query should only retrieve the records for the addresses you wish to send the email to.?
This query selects the name of the person and the email address from a bigger table. So no, it doesn't select exclusively the ones I'm selecting, that's where I have trouble.

Thank you for your input, I know what I want to do, I'm just having trouble executing it.
 
Ok, well the logic is all wrong.
We need a way of identifying who you wish to send the email to.
Then we need to loop through those, appending the names and the "," which Notes seem to require and send when out of the loop.

If you have a listbox then you can loop through that list and collect the addresses that way, assuming that you retrieve the email addresses when you populate the list.?

Are you doing that.?

The remainder of the logic I mentioned is the same.
 
Here is an example of looping through a listbox getting the info required.

Code:
Private Sub cmdShowSelections_Click()
Dim lngRow As Long
Dim strMsg As String

With Me.lstLocations
    For lngRow = 0 To .ListCount - 1
        If .Selected(lngRow) Then
            strMsg = strMsg & ", " & .Column(1, lngRow)
        End If
    Next lngRow
End With

' strip off leading comma and space '
If Len(strMsg) > 2 Then
    strMsg = Mid(strMsg, 3)
End If
MsgBox strMsg
End Sub
 
Here is a link into how VBA interacts with Lotus Notes.
http://www.fabalou.com/vbandvba/lotusnotesmail.asp

I've also amended the code to indicate the logic I mean. It has not been tested and I know strCurrentPath has no value, but it should give you a start.

Personally I'd probably use that link as my Notes Email module and just pass it the parameters from my VBA if I had such a need. Giving credit to the poster as well of course.

It hasn't indented correctly, but I'm sure you can correct that.

HTH

Code:
Private Sub Command39_Click()

Dim sToName As String
Dim sSubject As String
Dim sMessageBody As String
Dim Notesdb As Object
Dim NotesDoc As Object
Dim Notesrtf As Object
Dim NotesSession As Object
dim lngRow as Long
 
	Set NotesSession = CreateObject("Notes.NotesSession")
	Set Notesdb = NotesSession.GetDatabase("", "")
    Call Notesdb.OpenMail
    Rem make new mail message
    Set NotesDoc = Notesdb.CreateDocument
	With Me.listboxname
		For lngRow = 0 To .ListCount - 1
			If .Selected(lngRow) Then
				sToName = sToName & "," & .Column(2, lngRow)
			End If
		Next lngRow
	End With
	
	' strip off leading comma and space '
	If Len(sToName) > 1 Then
		sToName = Mid(sToName, 2)
	End If
	'MsgBox sToName
    
	' Now set up email and send
	NotesDoc.SendTo = sToName                          
    NotesDoc.Subject = ("Reporte ")
    Set Notesrtf = NotesDoc.CreateRichTextItem("body")
    Call Notesrtf.appendtext("Report")
    Call Notesrtf.addnewline(2)
    Rem attach Error Report doc
    's = ActiveDocument.Path + "\" + ActiveDocument.Name
    Call Notesrtf.embedObject(1454, "", strCurrentPath, "Mail.rtf")
    ' Now send message
                
    Call NotesDoc.Send(False)
	
	' Now clear objects
    Set NotesSession = Nothing
	Set Notesdb = Nothing
	Set Notesrtf = Nothing
	Set NotesDoc = Nothing
 
End Sub
 

Users who are viewing this thread

Back
Top Bottom