I am having trouble with the below code for which I get the following error message
Collaboration - Data Objects Mapi_e_not_found 8004010f)]]
Run Time Error 2147221233
Can someone help as I have the CDO reference in Tools, References
Public Sub SendEmail()
Dim i As Integer
Dim strSubject As String
Dim strMessage As String
Dim strRecipients As String
Dim sh As Worksheet
Dim wbSend As Workbook
Dim objSession As MAPI.Session
Dim objNewMessage As MAPI.Message
Dim objRecipient As MAPI.Recipient
Dim objAttachment As MAPI.Attachment
' Check the user is ok to send
If MsgBox(Prompt:="Ok?", Buttons:=vbYesNo) = vbNo Then Exit Sub
' Set the subject of the e-mail
strSubject = ""
' Set the text of the e-mail
strMessage = ""
' Set the recipient names
strRecipients = "
[email protected];
[email protected]"
' Save a tempory copy of the sheet with the correct filename
Set sh = ThisWorkbook.Sheets("Details")
Set wbSend = Workbooks.Add
sh.Copy Before:=wbSend.Sheets(1)
FName = "C:\..."
wbSend.SaveAs Filename:=FName
' Close the Temp file
wbSend.Close SaveChanges:=False
' Start CDO session
Set objSession = New MAPI.Session
objSession.Logon "", "", False, False
' Create a new message
Set objNewMessage = objSession.Outbox.Messages.Add
With objNewMessage
.Subject = strSubject
.Text = strMessage
' Add recipients one by one and resolve against the directory
i = InStr(1, strRecipients, ";", vbBinaryCompare)
Do Until i = 0
Set objRecipient = .Recipients.Add
objRecipient.Name = Left(strRecipients, i - 1)
objRecipient.Resolve
strRecipients = Mid(strRecipients, i + 2)
i = InStr(1, strRecipients, ";", vbBinaryCompare)
Loop
Set objRecipient = objNewMessage.Recipients.Add
objRecipient.Name = strRecipients
objRecipient.Resolve
End With
' Attach the tempory file to the e-mail
Set objAttachment = objNewMessage.Attachments.Add
objAttachment.Position = 0
objAttachment.Type = CdoFileData
objAttachment.ReadFromFile FName
objAttachment.Source = FName
' Delete the tempory copy
Kill FName
' Send the e-mail
objNewMessage.Update
objNewMessage.Send
'Release memory
Set objNewMessage = Nothing
Set objSession = Nothing
Set objAttachments = Nothing
Set objRecipient = Nothing
' Reassuring message
MsgBox "File send successful"
End Sub