SendMessage Error 2147417851

[Thomas Schmidt]

"SendMessage Error 2147417851 - Method 'Send of object'_DMailItem' failed"

I get this error message, runnig following code.
What I am doing wrong ??
Outlook is opening fine, also name resolving and file attachment
works, but "send" raise the error.


Function SendMessage(booDisplayMsg As Boolean, strTo As String, strCC As
String, strBCC As String, strSubject As String, strBody As String, Optional AttachmentPaths)

On Error GoTo Err_SendMessage

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

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

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
GoTo SkipCC
End If

' 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

strRecip = strRecips
Set objOutlookRecip = .Recipients.Add(strCC)
objOutlookRecip.Type = olCC

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
.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
End With

Exit_SendMessage:
Set objOutlook = Nothing
Exit Function

Err_SendMessage:
MsgBox "SendMessage Error " & Err.Number & " - " & Err.DESCRIPTION
Resume Exit_SendMessage