GetObject not getting Outlook.Application

[richh]

I have a stock function I use to test to see if Outlook is running before I attempt to draft an email. I've never had problems with it before, but today I ran the program and it doesn't acknowledge that Outlook is running. If I close/reopen the file, it seems to work and if I step through, it'll work as well. I also have a user who states she's having the same problem. I'm running Office 2010.

Public Function TestOutlookIsOpen(row As Long) As Integer
    Dim oOutlook As Object

    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0

    If oOutlook Is Nothing Then '//The program will occasionally see oOutlook as being empty. 
        TestOutlookIsOpen = -1
        MsgBox "Outlook is not running. Open Outlook and try again."
    Else
    
        If row <> -1 Then
            Call createEmail(row)
            TestOutlookIsOpen = 1 '//Some of my code first tests if Outlook is open and then performs tasks after, the rest do it up front and then tests.
        End If
    End If
End Function

 

[Kenneth Hobson]

Please paste code between code tags. Click # icon on reply toolbar to insert the tags.

That method was probably based on what Ron de Bruin lists at: https://www.rondebruin.nl/win/s1/outlook/openclose.htm

If you are the only user, you can try this.

Sub Test_exeCounts()
  MsgBox exeCounts("Outlook.exe")
End Sub

Public Function exeCounts(exe$) As Long
    Dim objProcesses As Object
    Set objProcesses = GetObject("winmgmts://" & Environ$("computerName") & _
      "/root/cimv2").ExecQuery("select * from Win32_Process where name='" _
      & exe & "'")
    If Not objProcesses Is Nothing Then
      exeCounts = objProcesses.Count
    End If
    Set objProcesses = Nothing
End Function

 

[lhartono]

First, try to repair your office Installation, there has been several case like this causing by corrupted office installation.

the try this...

'
'based on code by ZVI - MrExcelMVP
'
[COLOR=#0000cd]Public Function TestOutlookIsOpen(row As Long) As Integer
Dim oScript     As Object
Dim oOutlook    As Object
Dim OutLookPath As String
Dim TaskID      As Double

On Error Resume Next

Set oOutlook = GetObject(, "Outlook.Application")
If Err Then
    Set oScript = CreateObject("Wscript.Shell")
    OutLookPath = oScript.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\" & "OUTLOOK.EXE" & "\")
    If Err Then
        TestOutlookIsOpen = -1
        Set oScript = Nothing
        MsgBox "Outlook.exe is not found in this system"
        Exit Function
    End If
    TaskID = VBA.Shell(OutLookPath, vbNormalFocus)
    If GetObject(, "Outlook.Application") = "Outlook" Then
        Set oOutlook = GetObject(, "Outlook.Application")
    End If
End If

On Error GoTo HELL
    
If (Not oOutlook Is Nothing) And (row <> -1) Then
    Call createEmail(row)
    oOutlook.Quit
    TestOutlookIsOpen = 1 '//Some of my code first tests if Outlook is open and then performs tasks after, the rest do it up front and then tests.
End If

GETOUT:
    Set oScript = Nothing
    Set oOutlook = Nothing
    Exit Function
HELL:
    MsgBox "Error #: " & Err.Number & vbNewLine & vbNewLine & Err.Description & vbNewLine, vbCritical
    Resume GETOUT

End Function[/COLOR]

 

[richh]

Ihartono - your code works for the most part - however, now there's a different error I get. The majority of the time the program runs, it won't finish the save sequence or close without giving me several error messages on top of each other. I think it somehow gets hung up at HELL as I keep getting a crazy error message about the image being too large and it will be truncated. I don't even have an image in the file, lol....

I don't understand why though; it appears to run just fine. The form is updated appropriately, the email is drafted and sent, and I can step through the code no problem. I just can't save or close the file without error anymore.

 

[richh]

Ihartono - your code works for the most part - however, now there's a different error I get. The majority of the time the program runs, it won't finish the save sequence or close without giving me several error messages on top of each other. I think it somehow gets hung up at HELL as I keep getting a crazy error message about the image being too large and it will be truncated. I don't even have an image in the file, lol....

I don't understand why though; it appears to run just fine. The form is updated appropriately, the email is drafted and sent, and I can step through the code no problem. I just can't save or close the file without error anymore.

Actually, I'll recant that statement - those errors come up in the version I didn't implement the code. Perhaps it's the way I copy a sheet's content to another workbooks sheet?

Public Function createEmail(row As Long)
                        
    Dim wb1             As Workbook
    Dim wb2             As Workbook
    Dim newWS           As Worksheet
    Dim ws              As Worksheet
    Dim TempFilePath    As String
    Dim TempFileName    As String
    Dim FileExtStr      As String
    Dim fRow            As Integer
    Dim lRow            As Integer
    Dim i, j            As Integer
    Dim BodyTxt         As String
    Dim SendTo          As String
    Dim OutApp          As Object
    Dim NewMail         As Object
    Dim writeA          As Boolean
    Dim Answer          As Integer
    Dim cReq            As Variant

   
    Set wb1 = ThisWorkbook
    
    If row = 1 Then
        Set ws = ThisWorkbook.Worksheets("Positions")
    ElseIf row = 2 Then
        Set ws = ThisWorkbook.Worksheets("Updates Needed")
    End If
    
    Set otlApp = CreateObject("Outlook.Application")
    Set otlNewMail = otlApp.CreateItem(olMailItem)
    
    fRow = FirstInst
    lRow = LastInst
        
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    

    ' Make a copy of the file.
    TempFilePath = Environ$("temp") & "\"

    If row = 1 Then    
        TempFileName = UserInst & " Update"
    Else
        TempFileName = "Updates Required"
    End If
    
    FileExtStr = ".xlsx"

    Set wb2 = Workbooks.Add
    wb2.SaveAs TempFilePath & TempFileName & FileExtStr
    
    If row = 1 Then
        ws.Rows(1).EntireRow.Copy
        wb2.Worksheets("Sheet1").Range("A1").Select
        wb2.Worksheets("Sheet1").Paste
    
        wb2.Worksheets("Sheet1").Name = TempFileName
    
        j = 2
        
        For i = fRow To lRow
            ws.Rows(i).EntireRow.Copy
            wb2.Worksheets(TempFileName).Rows(j).Select
            wb2.Worksheets(TempFileName).Paste
            j = j + 1
        Next i
       

    ElseIf row = 2 Then '//I think this is where the errors may come from; perhaps Excel has too much data in memory that it hangs? 
        ws.Activate
        ws.Cells.Select
        Selection.Copy
        Set newWS = wb2.Worksheets("Sheet1")
        newWS.Activate
        newWS.Cells.Select
        newWS.Paste
        
    End If

I have never before seen this error in the two+ months of testing this small program. It figures the day this thing gets pushed to the field that all these weird errors start cropping up.

 

[Kenneth Hobson]

I thought that might be the case. I have not seen the image error message but I have seen the clipboard message to save it or not. There are 2 ways to avoid that.

The first is most appropriate here I think:
1. After the Paste, Application.CutCopyMode = False

 

[richh]

I thought that might be the case. I have not seen the image error message but I have seen the clipboard message to save it or not. There are 2 ways to avoid that.

The first is most appropriate here I think:
1. After the Paste, Application.CutCopyMode = False

hmm.. I still get the image error from time to time; it doesn't affect the program it seems; perhaps it's my user form? I do have my user form's height expand depending on the institution using the program to accommodate the number of frames to which they need access, but that gets unloaded after the info they key in is copied and an email is drafted/sent. I do have some small shapes on a couple of sheets to use as a background for the buttons. Perhaps those are throwing the error?

 

[Kenneth Hobson]

Sounds like a file is needed to see what is wrong. I guess you could post the code on the off chance something can be seen in it.

Look for Copy in your userform's code. Your resize may exceed the user's setup limitations or a control's size limit.

 

[richh]

Sounds like a file is needed to see what is wrong. I guess you could post the code on the off chance something can be seen in it.

Look for Copy in your userform's code. Your resize may exceed the user's setup limitations or a control's size limit.

OK, I'll post the file once I get home. My work has file sharing sites blocked, so I can't upload it anywhere.

I did find out that the reason my user was getting the error even after implementing the new code was that she is using web-based Outlook, so it's neither running nor installed. I removed all instances of the calls to TestOutlookIsOpen so she could execute the rest of the program and email me a copy of the workbook separately. That solved the issue of GetObject not working!

I still can't figure out the other problem though where I have a large image of some kind. I'll post the file with some info redacted later. Note that the contact list is really over 170 rows long.

I appreciate your time, Kenneth; this problem has made me crazy!

 

[richh]

https://1drv.ms/x/s!AgoDDOJuagFChH1808mzB15zNLkd

There's a link to my MS OneDrive. The GenInfo and Positions forms both make calls to TestOutLookIsOpen, as does Update_Check. GenInfo will pass -1 to the test to ensure outlook is open before it moves any further. Once the users fill in the Positions form, it will update the Positions worksheet and then email me the section that was updated and pass a 1 to the test function. Update_Check will look at the date the row was last updated and pull any that were not updated within the last three months into another sheet and pass a 2 to the test function.