Open an exchange message from IE

[astro86]

Hello all,
I am writing a script that is supposed to do a few simple things:
1) Start a single outlook if one is not running (Which looks to be fine)
2) Open a specific exchange server message, in outlook. This thing keeps returning the error: vbscript runtime error (3) object required 424. Look for the "***" to see where this happens.

The weird part is that sometimes the message will open and sometimes it does not. I have attached the code below and would really appreciate some help and pointers as to what I did wrong.

Thank you!

sub open_email(entryid, store_entryid)
  ' msgbox("ENTRYID = " & entryid & vbcrlf & vbcrlf & "STORE_ENTRYID = " &  store_entryid)
  On Error Resume Next                                           ' Turn on Error handling

  ' Check for correct scripting version.
  If ScriptEngineMajorVersion >= 2 Then

      ' Start Regardless of Whether or Not Microsoft Outlook is Already Running
      ' http://www.microsoft.com/technet/scriptcenter/resources/officetips/jun05/tips0614.mspx

      Const olFolderInbox = 6
      Dim objOutlook
      Dim objNamespace

      strComputer = "."

      Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
      Set colItems = objWMIService.ExecQuery _
          ("Select * From Win32_Process Where Name = 'outlook.exe'")

      If colItems.Count = 0 Then

          Set objOutlook = CreateObject("Outlook.Application")
          If Not objOutlook Then
              Set objOutlook = CreateObject("Outlook.Application", "localhost")
              If Err.Number And objOutlook is Nothing Then
                 msgbox Err.Source & " (11)" &vbcrlf & Err.description & vbcrlf & Err.Number
                 Err.Clear
              End If
          End If

          Set objNamespace = objOutlook.GetNamespace("MAPI")
          objNamespace.Logon "Default Outlook Profile",, False, True
          'objNamespace.GetDefaultFolder(olFolderInbox)

      Else
          Set objOutlook = CreateObject("Outlook.Application")
          Set objNamespace = objOutlook.GetNamespace("MAPI")
          'objNamespace.GetDefaultFolder(olFolderInbox)
      End If

      If Err.Number And objNamespace is Nothing Then
          msgbox Err.Source& " (2)" & vbcrlf & Err.description & vbcrlf & Err.Number
          Err.Clear
      End If

      ' Try to get the item with out the store_entryid
      set theitem = objNamespace.GetItemFromID(entryid)

      If Not theItem Then  ' If Err.Number Then
         ' Get the msg from outlook with the store entryid
         set theitem = objNamespace.GetItemFromID(entryid, store_entryid)
         msgbox theItem.Count
         If Err.Number and theItem is Nothing Then
'***
              msgbox Err.Source & " (3)" & vbcrlf & Err.description & vbcrlf & Err.Number
'***
              Err.Clear
         End If
      End If

      ' Show it.
      theitem.Display()

      ' Cleanup
      set objOutlook = Nothing

  Else
      MsgBox "Please download the latest version of VBScript at http://www.microsoft.com/technet/scriptcenter/default.mspx"
  End If

  ' Turn off Error handling
  On Error GoTo 0
end sub