?
Solved

Need to add multiple (more than two) email recipients in vba code...

Posted on 2008-10-06
12
Medium Priority
?
962 Views
Last Modified: 2012-06-21
I have more than two email recipients, how do I get them in there. I tried to seperate them with ";" but still won't work. Thanks for looking at it.


Public objOutlook As Object
Public objNS As Outlook.Namespace
Public objMsg As Outlook.MailItem
Public objRecipient As Outlook.Recipient

Sub SendEmail()
'Sets the objOutlook & objNS public variables to the user's Outlook session.
'This will blow up if Outlook is not running.
Set objOutlook = GetObject(, "Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
'Gets the user's name from Outlook, finds just the first name & places that into
'a public variable (strCurrentUser) & puts the full name (First Last) into
'a public variable (strCurrentUserFull).
'Used in other processes
strCurrentUserFull = objNS.CurrentUser
intChar = InStr(1, strCurrentUserFull, ",")
strCurrentUser = Mid(strCurrentUserFull, intChar + 2)
strCurrentUserFull = strCurrentUser & " " & Left(strCurrentUserFull, intChar - 1)
Dim Forwarder As String
Forwarder1 = "AGI"
Forwarder2 = "BAX"
Dim TodayDate As String
Dim todayyear As String
Dim todaymonth As String
Dim todayday As String
Dim todayhour As String
todaymonth = Month(Date)
todaymonth = IIf(Len(todaymonth) = 2, todaymonth, "0" & todaymonth)
todayday = Day(Date)
todayday = IIf(Len(todayday) = 2, todayday, "0" & todayday)
todayyear = Year(Date)
'todayhour = Hour(Now())
todayhour = 10
TodayDate = todayyear & "-" & todaymonth & "-" & todayday & "-" & todayhour


Dim sPath As String, sFileNm As String
sPath = "C:\Dsr\"
sFileNm = Dir(sPath, vbNormal) 'Get the first file from the specified directory

'Start a loop
Do While sFileNm <> ""
 'If the file has a dbf extension then print the file name
  If Right(sFileNm, 3) = "xls" Then
  '     Debug.Print sFileNm
   
Forwarder1 = Left(sFileNm, 3)
'*********************************************************NEED HELP HERE OR FURTHER DOWN
If Forwarder1 = "AGI" Then
Email = "Packingslip@limitedbrands.com"
Else
Email = "rlambotte@limitedbrands.com"
End If


Set objMsg = objNS.Application.CreateItem(olMailItem)
With objMsg
.Display
'Adds main recipient
'.Recipients.Add "lambotte, ronny"
.Recipients.Add Email

'*************************************This would work for one more, do I just repeet 2nd and 3rd line below
'Add CC recipient
'Set objRecipient = .Recipients.Add("")
'objRecipient.Type = olCC

.Subject = "TEST FOR DSR - TEST FOR DSR - EMAIL"
.Body = "Attached are the tracking reports for LATE PO and..." & TodayDate
Dim Name As String
Name = "c:\dsr\" & Forwarder1 & " EDI Mismatch Per DSR  " & TodayDate & ".xls"
.Attachments.Add Name, , 80
.Send
End With
    End If
    sFileNm = Dir
Loop


Set objMsg = Nothing
MsgBox "Emails Done", _
vbInformation, "Email Sent"
End Sub

0
Comment
Question by:kasimir2008
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 5
12 Comments
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 22653245
Try putting a space after the semicolon. I use semicolons to separate email address and it works.

Kevin
0
 

Author Comment

by:kasimir2008
ID: 22653325
I get a "Run Time Error, Automation Error" when I do that.
0
 

Author Comment

by:kasimir2008
ID: 22653367
Tried this, doesn't work with the THIRD one.

If Forwarder1 = "AGI" Then
Email = "Packingslip@limitedbrands.com"
Email2 = "rlambotte@limitedbrands.com"
Eamil3 = "6142076873@cingularme.com"
Else
Email = "rlambotte@limitedbrands.com"
Email2 = ""
End If


Set objMsg = objNS.Application.CreateItem(olMailItem)
With objMsg
.Display
'Adds main recipient
'.Recipients.Add "lambotte, ronny"
.Recipients.Add Email
'Add CC recipient

If Email2 <> Null Then
Set objRecipient = .Recipients.Add(Email2)
objRecipient.Type = olCC
End If

If Email3 <> Null Then
Set objRecipient = .Recipients.Add(Email3)
objRecipient.Type = olCC
End If
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 22653379
Semicolons almost always work.  If it still gives you trouble, just add your recipients one at a time using
the Add method of the Recipients collection.
0
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 22653440
Here is the routine I use to send emails through Outlook. It works with any number of email address passed as variant arrays.

Public Sub SendOutlookMail( _
      ByVal ToRecipients As Variant, _
      ByVal CCRecipients As Variant, _
      ByVal BCCRecipients As Variant, _
      ByVal Subject As String, _
      ByVal Body As String, _
      Optional ByVal UseHTML As Boolean = False _
   )

' Send an email using Outlook. The email is placed in Outlook's Drafts folder. Each
' generated email has to be opened and sent manually.

   Dim OutlookApplication As Object
   Dim Mail As Object
   
   If Not IsArray(ToRecipients) Then ToRecipients = Array(ToRecipients)
   If Not IsArray(CCRecipients) Then CCRecipients = Array(CCRecipients)
   If Not IsArray(BCCRecipients) Then BCCRecipients = Array(BCCRecipients)
   
   Set OutlookApplication = CreateObject("Outlook.Application")
   
   Set Mail = OutlookApplication.CreateItem(olMailItem)
   With Mail
      .To = Join(ToRecipients, "; ")
      .CC = Join(CCRecipients, "; ")
      .BCC = Join(BCCRecipients, "; ")
      .Subject = Subject
      On Error Resume Next
      .EditorType = 1 ' 2000
      .BodyFormat = 1 ' 2002, olFormatPlain
      On Error GoTo 0
      If UseHTML Then
         .HTMLBody = Body
      Else
         .Body = Body
      End If
      .Save
   End With
   
   Set Mail = Nothing
   Set OutlookApplication = Nothing

End Sub

Kevin
0
 

Author Comment

by:kasimir2008
ID: 22653447
How do I do that, matthewspatrick:

I tried this...

If Email2 <> Null Then
 Set objRecipient = .Recipients.Add(Email2)
  If Email3 <> Null Then
    .Recipients.Add (Email3)
  End If
End If
objRecipient.Type = olCC
0
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 22653483
To create a variant array on the fly:

   Dim ToAddresses As Variant
   ToAddresses = Array()
   Redim Preserve ToAddresses(LBound(ToAddresses) To UBound(ToAddresses) + 1)
   ToAddresses(UBound(ToAddresses)) = EMail
   If Email2 <> Null Then
      Redim Preserve ToAddresses(LBound(ToAddresses) To UBound(ToAddresses) + 1)
      ToAddresses(UBound(ToAddresses)) = Email2
   End If
   If Email3 <> Null Then
      Redim Preserve ToAddresses(LBound(ToAddresses) To UBound(ToAddresses) + 1)
      ToAddresses(UBound(ToAddresses)) = Email3
   End If

Kevin
0
 

Author Comment

by:kasimir2008
ID: 22653586
zorvek:
Thanks for helping, I think this might be a solution, but I am getting a Type mismatch error, and when I step through the code, After IF EMAIL2<> Null Then, it skips the IF part right after. Same with EMAIL3, it thinks it is FALSE.  I declared EMAIL, 2 and 3 and String.
0
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 22653611
  Dim ToAddresses As Variant
   ToAddresses = Array()
   Redim Preserve ToAddresses(LBound(ToAddresses) To UBound(ToAddresses) + 1)
   ToAddresses(UBound(ToAddresses)) = EMail
   If Len(Email2) > 0 Then
      Redim Preserve ToAddresses(LBound(ToAddresses) To UBound(ToAddresses) + 1)
      ToAddresses(UBound(ToAddresses)) = Email2
   End If
   If Len(Email3) > 0 Then
      Redim Preserve ToAddresses(LBound(ToAddresses) To UBound(ToAddresses) + 1)
      ToAddresses(UBound(ToAddresses)) = Email3
   End If

Kevin
0
 

Author Comment

by:kasimir2008
ID: 22653754
The code for the email part doesn't error out any more, thanks. But the Run Time Error 13, Type mismatch is still there.
Issue 1:
  ReDim Preserve ToAddresses(
the ToAddesses goes to empty and adds the next email after that in line. Looses the previous email address.
Issue2:
Also, the code throws an error
here with the Run Time Error, Type mismatch...using the array in the recipients line...
.Recipients.Add ToAddresses


Public objOutlook As Object
Public objNS As Outlook.Namespace
Public objMsg As Outlook.MailItem
Public objRecipient As Outlook.Recipient

Sub SendEmail()
Dim Email As String
Dim Email2 As String
Dim Email3 As String

'Sets the objOutlook & objNS public variables to the user's Outlook session.
'This will blow up if Outlook is not running.
Set objOutlook = GetObject(, "Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
'Gets the user's name from Outlook, finds just the first name & places that into
'a public variable (strCurrentUser) & puts the full name (First Last) into
'a public variable (strCurrentUserFull).
'Used in other processes
strCurrentUserFull = objNS.CurrentUser
intChar = InStr(1, strCurrentUserFull, ",")
strCurrentUser = Mid(strCurrentUserFull, intChar + 2)
strCurrentUserFull = strCurrentUser & " " & Left(strCurrentUserFull, intChar - 1)
Dim Forwarder As String
Forwarder1 = "AGI"
Forwarder2 = "BAX"
Dim TodayDate As String
Dim todayyear As String
Dim todaymonth As String
Dim todayday As String
Dim todayhour As String
todaymonth = Month(Date)
todaymonth = IIf(Len(todaymonth) = 2, todaymonth, "0" & todaymonth)
todayday = Day(Date)
todayday = IIf(Len(todayday) = 2, todayday, "0" & todayday)
todayyear = Year(Date)
'todayhour = Hour(Now())
todayhour = 10
TodayDate = todayyear & "-" & todaymonth & "-" & todayday & "-" & todayhour


Dim sPath As String, sFileNm As String
sPath = "C:\Dsr\"
sFileNm = Dir(sPath, vbNormal) 'Get the first file from the specified directory

'Start a loop
Do While sFileNm <> ""
 'If the file has a dbf extension then print the file name
  If Right(sFileNm, 3) = "xls" Then
  '     Debug.Print sFileNm
   
Forwarder1 = Left(sFileNm, 3)

If Forwarder1 = "AGI" Then
Email = "Packingslip@limitedbrands.com"
Email2 = "rlambotte@limitedbrands.com"
Email3 = "6142076873@cingularme.com"
Else
Email = "rlambotte@limitedbrands.com"
Email2 = ""
End If

Dim ToAddresses As Variant
   ToAddresses = Array()
   ReDim Preserve ToAddresses(LBound(ToAddresses) To UBound(ToAddresses) + 1)
   ToAddresses(UBound(ToAddresses)) = Email
   If Len(Email2) > 0 Then
      ReDim Preserve ToAddresses(LBound(ToAddresses) To UBound(ToAddresses) + 1)
      ToAddresses(UBound(ToAddresses)) = Email2
   End If
   If Len(Email3) > 0 Then
      ReDim Preserve ToAddresses(LBound(ToAddresses) To UBound(ToAddresses) + 1)
      ToAddresses(UBound(ToAddresses)) = Email3
   End If


Set objMsg = objNS.Application.CreateItem(olMailItem)
With objMsg
.Display
'Adds main recipient
'.Recipients.Add "lambotte, ronny"
.Recipients.Add ToAddresses
'Add CC recipient
'Set objRecipient = .Recipients.Add(Email2)
'objRecipient.Type = olCC

.Subject = "TEST FOR DSR - TEST FOR DSR - EMAIL"
.Body = "Attached are the tracking reports for LATE PO and..." & TodayDate
Dim Name As String
Name = "c:\dsr\" & Forwarder1 & " EDI Mismatch Per DSR  " & TodayDate & ".xls"
.Attachments.Add Name, , 80
.Send
End With
    End If
    sFileNm = Dir
Loop


Set objMsg = Nothing
MsgBox "Emails Done", _
vbInformation, "Email Sent"
End Sub
0
 
LVL 81

Accepted Solution

by:
zorvek (Kevin Jones) earned 2000 total points
ID: 22653849
When the Preserve phrase is used with a Redim the current array contents are not lost.

Change:

.Recipients.Add ToAddresses

To:

.To = Join(ToAddresses, "; ")

Kevin
0
 

Author Closing Comment

by:kasimir2008
ID: 31503557
Thank you so much.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

766 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question