Email Code - Outlook does not respond.

[jhallcb]

Hi guys,
Wrote a small piece of code in order to open a new outlook mail message, all that need to be set is the To: and Subject: in order that users can then input the body of any issues they are having to me, the administrator. This produced no errors however outlook did not open and if running already no new message was created. I have such looked through Google etc and pieced together a slightly longer code which again returns no errors but again nothing happens. With the updated code the command does not even load or act as though it is a command. Literally nothing. Can anyone see an issue with the code or have an idea why this would be? I have checked add-ins in outlook to ensure the vba is there, trust centre etc. starting to drive me a little mad.

Private Sub Label41_Click()
Dim Started As Boolean
Dim oApp As Outlook.Application
Dim oItem As Outlook.MailItem
On Error Resume Next
'Get Outlook if it's running
Set oApp = GetObject(, "Outlook.Application")
If Err <> 0 Then


'Outlook wasn't running, start it from code
Set oApp = CreateObject("Outlook.Application")
Started = True
End If
Set oItem = oApp.CreateItem(olMailItem)
With oItem
.To = "j.hall@dhl.com"
.Subject = "EMA FSC DB"
End With
Set oItem = Nothing
End Sub

[NoellaG]

Hi,

I think you created the message but forgot to show it using the display command. An example of code that works for me:


Public Function CreateMailMessage(strTo As String, strSubject As String, strBody As String, strFile As String) As Boolean
On Error GoTo Err_CreateMailMessage
Dim appOutlook As New Outlook.Application
Dim msg As Outlook.MailItem
Dim intpos As Integer

Set msg = appOutlook.CreateItem(olMailItem)

intpos = InStr(1, strTo, "#") --sometimes the address is preceeded by a hashtag, if so remove it
If intpos > 1 Then strTo = Left(strTo, intpos - 1)
msg.To = strTo
msg.Subject = strSubject
msg.Body = strBody
msg.Attachments.Add (strFile)
msg.Display

CreateMailMessage = True
Exit_CreateMailMessage:
Exit Function

Err_CreateMailMessage:
CreateMailMessage = False
Resume Exit_CreateMailMessage
End Function