Help Opening Outlook from Excel

[seanmic]

Hello all, and Happy New Year,


I have tried to find a solution to an issue I've encountered, but haven't been successful so I am hoping someone can assist. I am running into a problem where a macro that I've been trying to utilize will not function properly if Outlook is not open. I have limited experience using macros and vba, so I apologize in advance if I've missed anything that a proficient programmer such as yourselves would know to resolve.


The macro I've incorporated into the workbook and have been testing for a day now was posted online by Ron de Bruin, and I've tweaked slightly, and has been working great for me; however, during testing recently, I encountered a scenario that I cannot figure out how to resolve. It does not function correctly if Outlook is closed when the macro is run.


The workbook is going to be sent to a user group who will complete the workbook, and then at the bottom of the sheet they are supposed to click a button that will run a macro to automatically send the workbook as an attachment in Outlook. The issue I cannot solve for that I really need help with is that I continuously receive errors when trying to run the macro when Outlook is closed. I've tried several solutions located in various postings, but nothing seems to work.


I've provided some details below if any would be able to suggest a resolution.




Errors received:


1) [Microsoft Outlook popup] ---------> Microsoft Outlook has stopped working. Windows is checking for a solution to the problem...

2) [Microsoft Visual Basic popup] ---> Run-time error '429': ActiveX component can't create object

System specs:
Office Professional 2013
Windows 7






Current VB code:

Sub Employee_Mail_workbook_to_Mgr_Outlook_3()
'Working in Excel 2000-2013
'Mail a changed copy of the ActiveWorkbook with another file name


    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    Set wb1 = ActiveWorkbook


    'Make a copy of the file/Open it/Edit it/Mail it/Delete it
    'If you want to change the file name then change only TempFileName
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Survey - " & ThisWorkbook.Sheets("Sheet1").Range("D1").Value & "_" & ThisWorkbook.Sheets("Sheet1").Range("D2").Value & "_" & Format(Now, "yyyymmdd hhmmss")
    FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))


    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)




    '**************Add code to edit the file here********************
    'Insert a text and Date in cell A1 of the first sheet in the workbook.
    'Other things you can think of are for example, delete a whole sheet or a range.
    wb2.Worksheets(1).Range("C44").Value = "Electronically signed: " & Format(Now, "mm/dd/yyyy hh:mm:ss") & " by " & Environ("userdomain") & "\" & Environ("username")


    ActiveSheet.Buttons("Button 1").Delete
    
    'Save the file after we changed it with the code above
    wb2.Save




    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    
    On Error Resume Next
    With OutMail
        .To = ThisWorkbook.Sheets("Custom").Range("B14").Value
        .CC = ThisWorkbook.Sheets("Custom").Range("B20").Value
        .BCC = ""
        .Subject = ThisWorkbook.Sheets("Custom").Range("B10").Value
        .Body = ThisWorkbook.Sheets("Custom").Range("B4").Value
        .Attachments.Add wb2.FullName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0
    wb2.Close SaveChanges:=False


    'Delete the file
    Kill TempFilePath & TempFileName & FileExtStr


    Set OutMail = Nothing
    Set OutApp = Nothing


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Thank you in advance for any assistance you can provide

 

[John_w]

The issue I cannot solve for that I really need help with is that I continuously receive errors when trying to run the macro when Outlook is closed.

Add this function to the module:

Private Function IsOutlookRunning() As Boolean
    Dim outlook As Object
    Set outlook = Nothing
    On Error Resume Next
    Set outlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    IsOutlookRunning = Not outlook Is Nothing
End Function

And call it by inserting this code immediately before the Set OutApp = CreateObject("Outlook.Application") line:

    If Not IsOutlookRunning Then
        CreateObject("WScript.Shell").Run "outlook.exe", 3, False
    End If

 

[John_w]

Cross-posted Help Opening Outlook from Excel

Please post links to all other forums where you've posted this question. Excelguru Help Site - A message to forum cross posters

 

[seanmic]

[SOLVED] Help Opening Outlook from Excel

Add this function to the module:

Private Function IsOutlookRunning() As Boolean
    Dim outlook As Object
    Set outlook = Nothing
    On Error Resume Next
    Set outlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    IsOutlookRunning = Not outlook Is Nothing
End Function

And call it by inserting this code immediately before the Set OutApp = CreateObject("Outlook.Application") line:

    If Not IsOutlookRunning Then
        CreateObject("WScript.Shell").Run "outlook.exe", 3, False
    End If

John_W, you are a genius! Thank you so much for your assistance! It works perfectly!

 

[seanmic]

Regarding the cross posting -- apologies as this was my first post and I wasn't aware that was poor etiquette. thanks for the heads up!

 

[seanmic]

Add this function to the module:

Private Function IsOutlookRunning() As Boolean
    Dim outlook As Object
    Set outlook = Nothing
    On Error Resume Next
    Set outlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    IsOutlookRunning = Not outlook Is Nothing
End Function

And call it by inserting this code immediately before the Set OutApp = CreateObject("Outlook.Application") line:

    If Not IsOutlookRunning Then
        CreateObject("WScript.Shell").Run "outlook.exe", 3, False
    End If

This code works great to open Outlook, and I am VERY thankful to John_w for developing and providing the VBA!

After some testing, I noticed that if I have to submit several of these forms (which will be the case in my scenario) then there are several instances of Outlook open after completing each form. Would someone happen to know if if there is there a way to close the unique instance of Outlook that is created with this code after it has run and after the message has been sent? Please note, however, that I wouldn't want to close Outlook entirely, just the extra instances created when running this VBA. Thanks in advance for any help you can provide!

 

[John_w]

Try this:

    If Not IsOutlookRunning Then
        CreateObject("WScript.Shell").Run "outlook.exe", 3, False
        Set OutApp = CreateObject("Outlook.Application")
    Else
        Set OutApp = GetObject(, "Outlook.Application")
    End If