Mapi Code Fails on MapiSession.Outbox.Messages.Add

[DC Fan]

I posted this to comp.databases.ms-access, but got no reply yet. I thought
I would try the Outlook/Exchange/Mapi groups to see if anyone could throw me
a bone. Any help is greatly appreciated. Thanks in advance!

I am wirting an application in Access 2002 (XP) that needs to send email.
Since I hate the dialog boxes you get from all the Outlook warning messages,
I am trying to use the MAPI object. On *SOME* PC's the code runs fine, but
on others, the code can execute the logon portion of the code just fine, but
when it tries to create a message, I get the following error codes:

-2147221219, which when I look it up is MAPI_E_FAILONEPROVIDER. I can not
determine what the issue is.

The PCs have mixed OSs ranging from 98 to XP and various Access environment
ranging from none to XP. (I distribute code using Office Developer XP) I
have tested on my XP machine with Access XP installed and it works fine. I
have not found a pattern to the other PCs that don't work.

My code is below with the problem line marked with a '==>' in the l;eft
margin. The gstrMailProfile is a global variable that stores a profile
name. I have tested this by logging in without any profgile and having the
user pick a profile from the Outlook box.

I don't know what the error denotes or what the cause may be. Any
suggestion would be most helpfull! Thanks in advance.

-Graham

Public Function SendMAPIMessage() As Integer

SendMAPIMessage = 0

Dim MapiSession As Object
Dim MapiMessage As Object
Dim MapiRecipient As Object
Dim MapiAttachment As Object
Dim Recpt
Dim errObj As Long
Dim errMsg
Dim i As Integer
Dim iPosSemiColon As Integer
Dim sCurrentRecipient As String
Dim sTo As String
Dim sCC As String
Dim sBCC As String
Dim sSubject As String
Dim sBody As String
Dim sAttach As String

sTo = gstrMailTo
sCC = gstrMailCC
sBCC = gstrMailBCC
sSubject = gstrMailSubject
sBody = gstrMailBody
sAttach = gstrMailAttach

On Error GoTo MAPITrap
' Create the MAPI Session.
Set MapiSession = CreateObject("Mapi.Session")

' Log on to the session. If the ProfileName argument is omitted,
' Microsoft Exchange prompts you for the profile to use. If the
' profile name is incorrect, you will receive a runtime error.

MapiSession.Logon profilename:=Nz(gstrMailProfile, "")

' Add a message to the Outbox.
==> Set MapiMessage = MapiSession.Outbox.Messages.Add

' Add the recipients of the message. Note, each recipient must be
' added separately to the Recipients collection of the Message
' object.

With MapiMessage

While sTo <> ""
iPosSemiColon = InStr(1, sTo, ";")

If iPosSemiColon > 0 Then
sCurrentRecipient = Left(sTo, iPosSemiColon - 1)
sTo = Mid(sTo, iPosSemiColon + 1)
Else
sCurrentRecipient = sTo
sTo = ""
End If

Set MapiRecipient = MapiMessage.Recipients.Add
MapiRecipient.Name = sCurrentRecipient
MapiRecipient.Type = 1
'mapiTo = 1
'mapiCC = 2
'mapiBCC = 3
Wend

While sCC <> ""
iPosSemiColon = InStr(1, sCC, ";")

If iPosSemiColon > 0 Then
sCurrentRecipient = Left(sCC, iPosSemiColon - 1)
sCC = Mid(sCC, iPosSemiColon + 1)
Else
sCurrentRecipient = sCC
sCC = ""
End If

Set MapiRecipient = MapiMessage.Recipients.Add
MapiRecipient.Name = sCurrentRecipient
MapiRecipient.Type = 2
'mapiTo = 1
'mapiCC = 2
'mapiBCC = 3
Wend

While sBCC <> ""
iPosSemiColon = InStr(1, sBCC, ";")

If iPosSemiColon > 0 Then
sCurrentRecipient = Left(sBCC, iPosSemiColon - 1)
sBCC = Mid(sBCC, iPosSemiColon + 1)
Else
sCurrentRecipient = sBCC
sBCC = ""
End If

Set MapiRecipient = MapiMessage.Recipients.Add
MapiRecipient.Name = sCurrentRecipient
MapiRecipient.Type = 3
'mapiTo = 1
'mapiCC = 2
'mapiBCC = 3
Wend


' Resolve each recipient's e-mail name.
' Starting with Outlook version 8.03 (ref. Q172623)
' OLE Messaging 1.0 was replaced with Active Messaging 1.1.
' Outlook 98 (version 8.5) replaced Active Messaging
' with Microsoft CDO (Collaborative Data Objects) 1.21.
' OLE Messaging 1.0 uses a zero-based Recipients collection;
' Active Messaging 1.1 and Microsoft CDO 1.21 are 1-based.
For Recpt = 1 To .Recipients.Count
.Recipients(Recpt).Resolve showdialog:=False
Next

If sAttach <> "" Then
'Attach a file to the message.
'If FileExist(sFile) Then
Set MapiAttachment = MapiMessage.Attachments.Add
With MapiAttachment
.Name = Mid(sAttach, (InStrRev(sAttach, "\")) + 1)
'.Type = mapiFileData
'.Source = logfile
'.ReadFromFile filename:=logfile
.Source = sAttach
.ReadFromFile FileName:=sAttach
.Position = 2880
End With
'End If
End If
' Assign the text, subject, and importance of the message.
.Subject = sSubject
.Text = sBody & vbCrLf & vbCrLf

' View the message in Microsoft Exchange before sending. Set
' the ShowDialog argument to False if you want to send the
' message without viewing it in Microsoft Exchange.

'Set showdialog to False to send automatically.
'Set showdialog to true to display msg prior to sending.
.Send showdialog:=False

End With
MapiSession.Logoff
Set MapiSession = Nothing ' Clear the object variable.

SendMAPIMessage = 1 'Success

MAPIExit:
Exit Function

MAPITrap:
errObj = Err - vbObjectError ' Strip out the OLE automation error.
Select Case errObj
Case 275 ' User cancelled sending of message.
Resume MAPIExit
Case Else
errMsg = MsgBox("Error " & errObj & " was returned.")
Resume MAPIExit
End Select
End Function

 

[Ken Slovak - [MVP - Outlook]]

Please don't post to so many groups, pick one or two.

Are you sure that CDO 1.21 is installed on the systems where the code
fails? It's an optional installation for Outlook 2000 and later. You
need to check to see if you can create the MAPI.Session object in your
code, and you can demand install CDO if it's not installed. See the
ItemsCB COM addin sample on the Resources page at www.microeye.com for
an example of how to do that.