N
Newbie
Hi,
I am a complete novice and I have an Access XP application from which I can
email at the push of a button however the code that I have only allows for 1
To recipient and 1 Cc recipient.
Is it possible to have some code that will add as many recipients as need be
, if yes how would I go about achieving this
Al
FYI Here is the code I have already
Sub SendMessage(strEmailTo, Optional strEmailCc, Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim strMessage As String
strMessage = "The following error has occured: " & vbCrLf & vbCrLf
strMessage = strMessage & "Location: " & strLocation & vbCrLf & vbCrLf
strMessage = strMessage & "Error No. " & strError & vbCrLf & vbCrLf
strMessage = strMessage & "Description: " & strDesc
' 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(strEmailTo)
objOutlookRecip.Type = olTo
If Not IsMissing(strEmailCc) Then
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(strEmailCc)
objOutlookRecip.Type = olCC
End If
' Set the Subject, Body, and Importance of the message.
.Subject = "MIS Error"
.Body = strMessage
.Importance = olImportanceHigh 'High importance
' 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
.Display
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
I am a complete novice and I have an Access XP application from which I can
email at the push of a button however the code that I have only allows for 1
To recipient and 1 Cc recipient.
Is it possible to have some code that will add as many recipients as need be
, if yes how would I go about achieving this
Al
FYI Here is the code I have already
Sub SendMessage(strEmailTo, Optional strEmailCc, Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim strMessage As String
strMessage = "The following error has occured: " & vbCrLf & vbCrLf
strMessage = strMessage & "Location: " & strLocation & vbCrLf & vbCrLf
strMessage = strMessage & "Error No. " & strError & vbCrLf & vbCrLf
strMessage = strMessage & "Description: " & strDesc
' 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(strEmailTo)
objOutlookRecip.Type = olTo
If Not IsMissing(strEmailCc) Then
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(strEmailCc)
objOutlookRecip.Type = olCC
End If
' Set the Subject, Body, and Importance of the message.
.Subject = "MIS Error"
.Body = strMessage
.Importance = olImportanceHigh 'High importance
' 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
.Display
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub