ACCESS VBA code to send email's on Lotus 8.5

Ghostline

New Member
Joined
Aug 26, 2014
Messages
7
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
You've got too much stuff crammed together...and your looping is wrong...
see below

Rich (BB code):
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]
 
Upvote 0
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


(...)
 
Upvote 0
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 -->
Sent: Monday, September 22, 2014 4:42:51 PM
To: valcompv@hotmail.com; ghostline40

<tbody>
</tbody>


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

Rich (BB code):
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]
 
Upvote 0
Here's the loop for 1 email to many.

yes paste in the button click

Rich (BB code):
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][
 
Upvote 0
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

Rich (BB code):
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]
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,288
Members
448,563
Latest member
MushtaqAli

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top