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
