Senin, 02 Juli 2018

RE: [MS_AccessPros] sending multiple attachments through Lotusmaill

 

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)

Have you tried the highest rated email app?
With 4.5 stars in iTunes, the Yahoo Mail app is the highest rated email app on the market. What are you waiting for? Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.


.

__,_._,___

Tidak ada komentar:

Posting Komentar