Thanks Bill. I just got this, but I realized I just needed to use an array.
Private Sub PrepAndSendEmail()
On Error GoTo err_out
Dim db As DAO.Database
Dim rsTo As DAO.Recordset
Dim rsAtt As DAO.Recordset
Dim strsql As String
Set db = CurrentDb()
' get the email list
Set rsTo = db.OpenRecordset("EmailList")
Dim strTo As String
While Not rsTo.EOF
strTo = rsTo(0).Value & "; " & strTo
rsTo.MoveNext
Wend
' get the list of attachments to send
Set rsAtt = db.OpenRecordset("pdfFiles")
rsAtt.MoveLast
Dim i As Integer ' for the item in the attachment array
i = rsAtt.RecordCount
ReDim stratt(i) As String
rsAtt.MoveFirst
i = 0
While Not rsAtt.EOF
stratt(i) = rsAtt(0).Value
i = i + 1
rsAtt.MoveNext
Wend
' stratt = stratt & "'"
' stratt = Left(stratt, Len(stratt) - 3)
' stratt = "array(" & stratt & ")"
If EmailSent("PlannerReports@beaerospace.com", strTo, "Planner reporting test only", "Soon to be implemented", stratt) Then
Me.txtStatus = "Emails have been sent"
Else
Me.txtStatus = "Emails were not sent"
GoTo err_out
End If
'If EmailSent("test@beaerospace.com", strTo, "test", "test", "k:\Production Control\Program Folder\PlannerRptsFromDB\NEXGEN PS PO-6-27.pdf") Then
GoTo exit_out
err_out:
MsgBox ("Error in PrepAndSendEmail: " & Err.Number & vbCrLf & Err.Description)
exit_out:
Set rsTo = Nothing
Set rsAtt = Nothing
Set db = Nothing
End Sub
Respectfully,
[RCEmailSigLogo]
Liz Ravenwood
Data Technologies
Interior Systems
Rockwell Collins
1851 So. Pantano Rd, Tucson, AZ 85710 USA
(520) 239-4808
Liz_ravenwood@beaerospace.com<mailto:Liz_ravenwood@beaerospace.com>
rockwellcollins.com<http://www.rockwellcollins.com/>
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Monday, July 2, 2018 9:17 AM
To: Liz Ravenwood liz_ravenwood@beaerospace.com [MS_Access_Professionals]; Home
Subject: Re: [MS_AccessPros] sending multiple attachments through Lotusmaill
Pop. I see you are using Lotus notes. But maybe you can edit your code after seeing mine
Regards,
Bill Mosca
------ Original message------
From: Liz Ravenwood liz_ravenwood@beaerospace.com<mailto:%20liz_ravenwood@beaerospace.com> [MS_Access_Professionals]
Date: Mon, Jul 2, 2018 8:13 AM
To: MS_Access_Professionals@yahoogroups.com<mailto:MS_Access_Professionals@yahoogroups.com>;
Cc:
Subject:[MS_AccessPros! ] sending multiple attachments through Lotusmaill
Friends, I need to email multiple attachments, and the code runs but fails to send anything. I can send one attachment only.
Anyone know how to do this?
Here's the function:
Public Function EmailSent(strFrom As String, strTo As String, strSub As String, strBody As String, Optional strAttach As Variant) As Boolean
On Error GoTo err_out
Dim L As LotusMail.Utility, Output As String
Set L = New LotusMail.Utility
' FROM, TO, Subject, Body, Attachment
Output = L.Se<http://L.Se>ndMail(strFrom, strTo, strSub, strBody, strAttach)
Set L = Nothing
EmailSent = True
GoTo exit_out
err_out:
EmailSent = False
exit_out:
'bye
End Function
And here is the calling code:
Private Sub PrepAndSendEmail()
On Error GoTo err_out
Dim db As DAO.Database
Dim rsTo As DAO.Re<http://DAO.Re>cordset
Dim rsAtt As DAO.Re<http://DAO.Re>cordset
Dim strsql As String
Set db = CurrentDb()
Set rsTo = db.OpenRecordset("EmailList")
Dim strTo As String
While Not rsTo.EOF
strTo = rsTo(0).Value & "; " & strTo
rsTo.Mo<http://rsTo.Mo>veNext
Wend
Set rsAtt = db.OpenRecordset("pdfFiles")
Dim strAtt As String
strAtt = ""
While Not rsAtt.EOF
strAtt = "'" & rsAtt(0).Value & "', " & strAtt
rsAtt.Mo<http://rsAtt.Mo>veNext
Wend
strAtt = strAtt & "'"
strAtt = Left(strAtt, Len(strAtt) - 3)
strAtt = "array(" & strAtt & ")"
If EmailSent("PlannerReports@beaerospace.com<mailto:>", strTo, "Planner reporting test only", "Soon to be implemented", strAtt) Then
Me.txtStatus = "Emails have been sent"
Else
Me.txtStatus = "Emails were not sent"
GoTo err_out
End If
'If EmailSent("test@beaerospace.com<mailto:>", strTo, "test", "test", "k:\Production Control\Program Folder\PlannerRptsFromDB\NEXGEN PS PO-6-27.pdf") Then
GoTo exit_out
err_out:
MsgBox ("Error in PrepAndSendEmail: " & Err.Nu<http://Err.Nu>mber & vbCrLf & Err.De<http://Err.De>scription)
exit_out:
Set rsTo = Nothing
Set rsAtt = Nothing
Set db = Nothing
End Sub
Respectfully,
[RCEmailSigLogo]
Liz Ravenwood
Data Technologies
Interior Systems
Rockwell Collins
1851 So. Pantano Rd, Tucson, AZ 85710 USA
(520) 239-4808<tel:(520)%20239-4808>
Liz_ravenwood@beaerospace.com<mailto:Liz_ravenwood@beaerospace.com><mailto:Liz_ravenwood@beaerospace.com></mailto<mailto::Liz_ravenwood@beaerospace.com>
rockwellcollins.com<http://rockwellcollins.com><http://www.rockwellcollins.com/>
This email (and all attachments) is for the sole use of the intended recipient(s) and may contain privileged and/or proprietary information. Any unauthorized review, use, disclosure or distribution is prohibited. If you are not the intended recipient, please contact the sender by reply e-mail and destroy all copies of the original message.
[Non-text portions of this message have been removed]
This email (and all attachments) is for the sole use of the intended recipient(s) and may contain privileged and/or proprietary information. Any unauthorized review, use, disclosure or distribution is prohibited. If you are not the intended recipient, please contact the sender by reply e-mail and destroy all copies of the original message.
[Non-text portions of this message have been removed]
Posted by: Liz Ravenwood <Liz_Ravenwood@beaerospace.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (4) |
Tidak ada komentar:
Posting Komentar