G
Guest
Can anyone suggest another option? I tried the below suggestion and the
emails still will not resolve if there is more than one address in the olTo
field.
Thank you for your help,
Sandy
Correct me if I'm wrong, but it looks like your grabbing the person's
first and last name.
Smith, Bill
My suggestion would be to store the email address in another column and
grab that instead
(e-mail address removed)
Append a semicolon after each name and return the string.
I've used this with reports to as many as 70 people, and never had a
problem.
Also, I wouldn't build an array, just append a string
strEmails = strEmails & rs![epEmail] & "; "
Hope this helps,
Chris
emails still will not resolve if there is more than one address in the olTo
field.
Thank you for your help,
Sandy
Correct me if I'm wrong, but it looks like your grabbing the person's
first and last name.
Smith, Bill
My suggestion would be to store the email address in another column and
grab that instead
(e-mail address removed)
Append a semicolon after each name and return the string.
I've used this with reports to as many as 70 people, and never had a
problem.
Also, I wouldn't build an array, just append a string
strEmails = strEmails & rs![epEmail] & "; "
Hope this helps,
Chris
I am having an issue with my email code that when I attempt to use more than
one address as an email string for the olTo and olCc fields, the resolve
function in ol is taking too long, and susequently opens the mail object -
which, resolves the addresses and then you can manually Send the mail object.
Does anyone have a suggestion to make my code resolve in outlook faster so
the email will send without opening the up? I thought maybe putting each
address into a loop where I add it to the olTo field and then resolving each
but am not sure - examples would be much appreciated!
Here is my 3 procedures/functions I am using.
The first is a function that returns the email string used for olTo and
olCc. The second is the procedure that send the email, and the third is the
procedure I am using to test the second procedure.
/////////////////////////////////////////////////////////
'Creates the Distribution List
Option Base 1
'Creates Distribution List
Function CreateDistro(Level As String) As String
Dim EMAIL As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strEmailCriteria As String, strEmailDistro As String
Dim EmailArray() As String
Dim i As Integer, ii As Integer
Dim LenStr As Integer, LenStrEmail As Integer
Set rs = New ADODB.Recordset
strEmailCriteria = "USCDL" & "*"
strSQLEmail = "SELECT tblCustomerService.[epnamel],
tblCustomerService.[epnamef],tblCustomerService.DistributionID " & _
"FROM tblCustomerService WHERE (((tblCustomerService.DistributionID)= '" &
Level & "'));"
rs.Open _
Source:=strSQLEmail, _
ActiveConnection:=CurrentProject.Connection, _
CursorType:=adOpenForwardOnly, _
LockType:=adLockOptimistic
i = 1
rs.MoveFirst
Do While Not rs.EOF
ReDim Preserve EmailArray(i)
EmailArray(i) = rs![epnamel] & ", " & rs![epnamef] & "; "
rs.MoveNext
i = i + 1
Loop
i = i - 1 'sets i equal to the number of items in EmailArray
strEmailDistro = "" ' starts the string at nothing
For ii = 1 To i
strEmailDistro = strEmailDistro & EmailArray(ii)
Next
LenStr = Len(strEmailDistro)
LenStrEmail = (LenStr - 2)
strEmailDistro = Left(strEmailDistro, LenStrEmail) 'removes extra ; at end
of string
CreateDistro = strEmailDistro
End Function
////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////
'Creates the Email Object
Public Sub SendMessage(MsgSubject As String, MsgBody As String,
MsgImportance As Variant, ToEmail As String, CcEmail As String, Optional
AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(ToEmail)
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(CcEmail)
objOutlookRecip.Type = olCC
' Set the Subject, Body, and Importance of the message.
.Subject = MsgSubject
.Body = MsgBody
.Importance = MsgImportance 'olImportanceHigh
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
//////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////
'Procedure to call SendMessage()
Public Sub sendnew()
'these are the following required arguments for the email
'MsgSubject As String, MsgBody As String, MsgImportance As Variant
'ToEmail As String, CcEmail As String, Optional AttachmentPath (no
attachment - just a message)
'MsgImportance may be one of the followinglImportanceLow,
olImportanceNormal, olImportanceHigh
'...................................................
Dim AttachmentPath As String, MsgSubject As String, MsgBody As String
Dim MsgImportance As String, ToEmail As String, CcEmail As String
'Set Message Variables
MsgSubject = "test"
MsgBody = "variable test"
MsgImportance = olImportanceNormal
ToEmail = CreateDistro(1)
CcEmail = CreateDistro(2)
'OPTIONAL////save report to the shared drive
DoCmd.OutputTo acOutputReport, "rptTeamList", "RichTextFormat(*.rtf)",
CurrentProject.Path & "\TeamReport.rtf"
AttachmentPath = CurrentProject.Path & "\TeamReport.rtf"
'call the function to send the email
Call SendMessage(MsgSubject, MsgBody, MsgImportance, ToEmail, CcEmail,
AttachmentPath)
End Sub