Outlook not opening properly when sending email via Excel VBA

[gallan]

I have a macro to send an email. It works fine if Outlook is already open before I click Send on my userform. But if I do not have Outlook open ahead of time the routine fails, although I have code in it to create an instance of Outlook and I can see the Outlook icon on the task bar after I click Send. Any ideas, please. I get "Application defined or object defined" error message.

Code below:


Private Sub CBSend_Click()

'automatically sends from Outlook, so one must be signed in before hand

Dim Mail_Object As Variant
Dim Mail_Single As Variant

Dim ChrCtr As Integer
Dim ChrCtr2 As Integer

On Error GoTo debugs

Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)

With Mail_Single
.Subject = EM.TBSubject.Value
.To = EM.TBEmailContact.Value
.CC = "" 'Email_Cc
.BCC = "" 'Email_Bcc
.Body = EM.TBMessage.Value
End With

If AttachMks Then
With Mail_Single
.Attachments.Add DestWB.FullName
End With
End If

If OtherAttached Then
With Mail_Single
If EM.TBOtherAttached <> "None" Then ' have some other attachments
ChrCtr = 1 '11 ' start at first attachment after "Attached: "
ChrCtr2 = 0
Do Until ChrCtr + ChrCtr2 = Len(EM.TBOtherAttached) ' find end of list
If Mid(EM.TBOtherAttached, ChrCtr + ChrCtr2, 2) = "; " Then ' find marker between files
.Attachments.Add Mid(EM.TBOtherAttached, ChrCtr, ChrCtr2)
ChrCtr = ChrCtr + ChrCtr2 + 2 ' skip over "; " to start of next file to send
ChrCtr2 = 0 ' reset
End If
ChrCtr2 = ChrCtr2 + 1
Loop
.Attachments.Add Mid(EM.TBOtherAttached, ChrCtr, ChrCtr2 + 1) ' add last file on list
End If
End With
End If

With Mail_Single
.send
End With

MsgBox "Message sent ... check your outbox or sent folder for a copy ..."
MsgSent = True

EM.TBSubject.Value = ThisWorkBook.Sheets("CI").Range(StUsualNameLoc).Offset(EM.SpinButtonSts.Value, 0) & "'s progress in " & ThisWorkBook.Sheets("CI").Range(Course).Offset(0, 1)
EM.TBMessage.Value = ""

If CellHasComment(ThisWorkBook.Sheets("CI").Range(EmailLoc).Offset(EM.SpinButtonSts.Value, 0)) Then ' clear any stored message since this is now sent
MyAddComment ThisWorkBook.Sheets("CI").Range(EmailLoc).Offset(EM.SpinButtonSts.Value, 0), ""
End If

If AttachMks Then
DestWB.Close
Kill ThisWorkBook.Path & "\Data\" & IFName & FileExtStr
End If

debugs:

If Err.Description <> "" Then
MsgBox Err.Description
End If

End Sub