ACCESS VBA code to send email's on Lotus 8.5

[Ghostline]

Hi to all;

I've this code bellow is to send email's field in access but it only send to the first email only;

rst! --> test@test.com,test@test2.com

It can be 1, 2 or more;

---/---

Private Sub Command43_Click()
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim rst As DAO.Recordset
Dim strBody
'Dim strBody2

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fspenTextFile("L:\teste.txt", ForReading)
strBody = f.ReadAll
f.Close
Set rst = Form_RC_S_NC.RecordsetClone
rst.MoveFirst
Do While Not rst.EOF

SendTo1 = rst![Email]

ESubject = "Teste" & " " & rst![SAP] & " " & rst![Nome]

Dim Session As Object
Dim EmbedObj1 As Object
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
Recipient = SendTo1

MailDoc.SendTo = SendTo1

MailDoc.Subject = ESubject
MailDoc.Body = strBody
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1

MailDoc.Send 0, SendTo1

MailDoc.Save = True

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
skip_email:
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub

 

[ranman256]

You've got too much stuff crammed together...and your looping is wrong...
see below

Public Sub GetData2Mail()
Dim rst As DAO.Recordset
Dim strBody
Dim Sendto1, Esubject
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("L:\teste.txt", ForReading)
strBody = f.ReadAll
f.Close
Set rst = Form_RC_S_NC.RecordsetClone
'send 1 email with everyones address, or
'sent many emails, 1 per person
While Not rst.EOF
  Sendto1 = rst!
  Esubject = "Teste" & " " & rst![SAP] & " " & rst![Nome]
   
  SendEmail Sendto1, Esubject, strBody
  
  rst.MoveNext
Wend
rst.Close
Set rst = Nothing
End Sub


Private Sub SendEmail(ByVal pvTo, ByVal pvSubj, ByVal pvBody)
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
'Dim strBody2
Dim Session As Object
Dim EmbedObj1 As Object
On Error GoTo errorhandler1
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)

If Maildb.IsOpen = True Then
Else
   Maildb.OPENMAIL
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
Recipient = Sendto1
With MailDoc
    .SendTo = pvTo
    .Subject = pvSubj
    .Body = pvBody
    .PostedDate = Now()
End With
MailDoc.Send 0, Sendto1
MailDoc.Save = True
endit:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
Exit Sub
errorhandler1:
MsgBox Err.Description, , Err
Resume endit
End Sub
 [/code]

 

[Ghostline]

Thx for your reply. I'm nOOb


That code is to be put on a from button on access can I copy it and paste ( make all the changes ( on the text and subject )?
(...)

'send 1 email with everyone address, or 'sent many emails, 1 per person While Not rst.EOF
(...)

What I pretend is to send one email with all email's on rst! how can it be with the code that you give


(...)

 

[Ghostline]

Still the code only send to the first person on rst!Email ( the TO only goes to the second @ )

Lotus sent --> valcompv@hotmail.com;ghostline40@gmail.com

Receive party -->

Monday, September 22, 2014 4:42:51 PM

valcompv@hotmail.com; ghostline40

<tbody>
[TD="class: ReadMsgHeaderCol1"]Sent:[/TD]

[TD="class: ReadMsgHeaderCol1"] To:[/TD]

</tbody>

QUOTE=ranman256;3943354]You've got too much stuff crammed together...and your looping is wrong...
see below

Public Sub GetData2Mail()
Dim rst As DAO.Recordset
Dim strBody
Dim Sendto1, Esubject
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("L:\teste.txt", ForReading)
strBody = f.ReadAll
f.Close
Set rst = Form_RC_S_NC.RecordsetClone
'send 1 email with everyones address, or
'sent many emails, 1 per person
While Not rst.EOF
  Sendto1 = rst!
  Esubject = "Teste" & " " & rst![SAP] & " " & rst![Nome]
   
  SendEmail Sendto1, Esubject, strBody
  
  rst.MoveNext
Wend
rst.Close
Set rst = Nothing
End Sub


Private Sub SendEmail(ByVal pvTo, ByVal pvSubj, ByVal pvBody)
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
'Dim strBody2
Dim Session As Object
Dim EmbedObj1 As Object
On Error GoTo errorhandler1
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)

If Maildb.IsOpen = True Then
Else
   Maildb.OPENMAIL
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
Recipient = Sendto1
With MailDoc
    .SendTo = pvTo
    .Subject = pvSubj
    .Body = pvBody
    .PostedDate = Now()
End With
MailDoc.Send 0, Sendto1
MailDoc.Save = True
endit:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
Exit Sub
errorhandler1:
MsgBox Err.Description, , Err
Resume endit
End Sub
 [/code][/QUOTE]

 

[ranman256]

Here's the loop for 1 email to many.

yes paste in the button click

While Not rst.EOF
  Sendto1 = Sendto1 &  rst! & ";"
  
  rst.MoveNext
Wend
  Esubject = "Teste" & " " & rst![SAP] & " " & rst![Nome]   
  SendEmail Sendto1, Esubject, strBody
rst.Close
Set rst = Nothing
End Sub

[/code][

 

[Ghostline]

Still the same Lotus cut all others email's.
It transfer until the second @ all other is cut

Here's the loop for 1 email to many.

yes paste in the button click

While Not rst.EOF
  Sendto1 = Sendto1 &  rst! & ";"
  
  rst.MoveNext
Wend
  Esubject = "Teste" & " " & rst![SAP] & " " & rst![Nome]   
  SendEmail Sendto1, Esubject, strBody
rst.Close
Set rst = Nothing
End Sub

[/code][[/QUOTE]

 

[Ghostline]

Thx for your help I've fix it.
The error was in;

Sendto1 = Split(rst!, ",", 1)