transferring multiple email addresses to Outlook

Axis

Registered User.
Local time
Today, 22:58
Joined
Feb 3, 2000
Messages
74
I have a form that lets users select criteria and creates a query that includes email addresses based on their input. I want to be able to take the email addresses and have them automatically transferred to an Outlook message form. I'm moderately knowledgable about VBA but can't figure out how to do this one. Any suggestions would be greatly appreciated.
 
You could use the function below. I found it one on one of the help sites but I dont know who wrote it. However, it is v well writte and works just fine.

Function fnSendMessage(booDisplayMsg As Boolean, strTo As String, strCC As String, strBCC As String, strSubject As String, strBody As String, Optional AttachmentPaths) As Boolean
On Error GoTo Err_SendMessage

'Use StrCC = "none" when no CC
'Use StrBCC = "none" when no BCC
'Separate multiple recipients with semi-colon (
wink.gif

'AttachmentPaths is optional
'Separate multiple attachment-paths with semi-colon

'assume successful sending of message
fnSendMessage = True

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim strRecips As String
Dim strRecip As String
Dim strAttachPaths As String
Dim strAttachPath As String

' 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.
strRecips = strTo
Do While strRecips Like "*;*"
strRecip = Trim(Left(strRecips, InStr(strRecips, ";") - 1))
strRecips = Trim(Right(strRecips, Len(strRecips) - InStr(strRecips, ";")))
Set objOutlookRecip = .Recipients.Add(strRecip)
objOutlookRecip.Type = olTo
Loop

strRecip = strRecips
Set objOutlookRecip = .Recipients.Add(strRecip)
objOutlookRecip.Type = olTo

' If strCC = "none" Then
If Nz(strCC, "") = "" Then
GoTo SkipCC
End If
'MsgBox strCC
' Add the CC recipient(s) to the message.
strRecips = strCC
'Do While strRecips Like "*;*"
'strRecip = Trim(Left(strRecips, InStr(strRecips, ";") - 1))

'strRecips = Trim(Right(strRecips, Len(strRecips) - InStr(strRecips, ";")))
Set objOutlookRecip = .Recipients.Add(strRecip)
objOutlookRecip.Type = olCC
'Loop
MsgBox "strRecips is " & strRecips
strRecip = strRecips
Set objOutlookRecip = .Recipients.Add(strCC)
objOutlookRecip.Type = olCC
MsgBox "strRecip is " & strRecip
SkipCC:

If strBCC = "none" Then
GoTo SkipBCC
End If

' Add the BCC recipient(s) to the message.
strRecips = strBCC
Do While strRecips Like "*;*"
strRecip = Trim(Left(strRecips, InStr(strRecips, ";") - 1))
strRecips = Trim(Right(strRecips, Len(strRecips) - InStr(strRecips, ";")))
Set objOutlookRecip = .Recipients.Add(strRecip)
objOutlookRecip.Type = olBCC
Loop

strRecip = strRecips
Set objOutlookRecip = .Recipients.Add(strBCC)
objOutlookRecip.Type = olBCC

SkipBCC:

' Set the Subject, Body, and Importance of the message.
.Subject = strSubject
.Body = strBody
'.Body = rpt
.Importance = olImportanceHigh 'High importance

' Add attachments to the message.
If IsMissing(AttachmentPaths) Then
GoTo SkipAttach
End If

strAttachPaths = AttachmentPaths
Do While strAttachPaths Like "*;*"
strAttachPath = Trim(Left(strAttachPaths, InStr(strAttachPaths, ";") - 1))
strAttachPaths = Trim(Right(strAttachPaths, Len(strAttachPaths) - InStr(strAttachPaths, ";")))
Set objOutlookAttach = .Attachments.Add(strAttachPath)
Loop

strAttachPath = strAttachPaths
Set objOutlookAttach = .Attachments.Add(strAttachPath)

SkipAttach:

' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next

' Should we display the message before sending?
If booDisplayMsg Then
.Display
Else
.Save
.Send
End If
'check if message actually sent


End With

fnSendMessage = fnSendMessage
'MsgBox "fnSendMessage is " & fnSendMessage
Exit_SendMessage:
Set objOutlook = Nothing
Exit Function

Err_SendMessage:
MsgBox "SendMessage Error " & err.Number & " - " & err.Description
fnSendMessage = False
Resume Exit_SendMessage
End Function
 

Users who are viewing this thread

Back
Top Bottom