Question

I have code that sends an email with an attachment using Thunderbird which works fine. However, sometimes Thunderbird must be re-opened manually in order for that code to work (rarly).

If I have an error, how can I close the Thunderbird application, re-open it and run this code again?

Public Function fSendThunderbird()

Dim strCommand As String
Dim strTo as string, strCC As String
Dim strSubject As String
Dim strBody As String
Dim strFilePath As String

strTo = "myemail@.cie.com"
strCC = "myemail@.cie.com"
strSubject = ThisWorkbook.Name & " " & Format(Range("E3").Value, "mmmm yyyy")
strFilePath = Application.ActiveWorkbook.FullName
strBody = "Hello"

strCommand = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird"
strCommand = strCommand & " -compose " & "to=" & strTo & "," & "cc=" & strCC & "," & _
"subject=" & strSubject & "," & "attachment=" & strFilePath

Call Shell(strCommand, vbNormalFocus)

End Function
Was it helpful?

Solution

You can have the function call itself, as it appears it should be opening thunderbird via Shell. I highly recommend you get the error number and what occurred when this doesn't work though.

Public Function fSendThunderbird()
    on error goto errsend

    Dim strCommand As String
    Dim strTo as string, strCC As String
    Dim strSubject As String
    Dim strBody As String
    Dim strFilePath As String

    strTo = "myemail@.cie.com"
    strCC = "myemail@.cie.com"
    strSubject = ThisWorkbook.Name & " " & Format(Range("E3").Value, "mmmm yyyy")
    strFilePath = Application.ActiveWorkbook.FullName
    strBody = "Hello"

    strCommand = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird"
    strCommand = strCommand & " -compose " & "to=" & strTo & "," & "cc=" & strCC & "," & _
    "subject=" & strSubject & "," & "attachment=" & strFilePath

    Call Shell(strCommand, vbNormalFocus)

End Function

Exit Function 
    errsend:
         'Highly recommend handling errors here. 49999 is just an example
         If err.No = 49999 then
            'fatal error
            Call KillThunderbird
         else
            Call fSendThunderbird()
         end if
End Function

Sub KillThunderBird
    Dim oServ As Object
    Dim cProc As Variant
    Dim oProc As Object
    Set oServ = GetObject("winmgmts:")
    Set cProc = oServ.ExecQuery("Select * from Win32_Process")

    For Each oProc In cProc

        'Rename THUNDERBIRD to match what it comes up in as in Task Manager Processes

        If oProc.Name = "THUNDERBIRD.EXE" Then
            errReturnCode = oProc.Terminate()
        End If
    Next oProc
End Sub
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top