Testing if App exists

Freshman

Freshman

Registered User.
Local time
Today, 09:57
Joined
May 21, 2010
Messages
437
Hi all,

I've been using the bottom function for a few years but recently tested it due to a time delay at a Client and found it now suddenly shows 'False' in the test code on my machine even though I'm running Outlook on mine.
Could it be because I run Access 2003 but Outlook 2013 ?
Is there a more sure way of testing for Outlook covering all versions?

Thanks

Code: 
Function ApplicationIsAvailable(ApplicationClassName As String) As Boolean
Dim AnyApp As Object

  On Error Resume Next
  Set AnyApp = CreateObject(ApplicationClassName)
  ApplicationIsAvailable = Not AnyApp Is Nothing
  Set AnyApp = Nothing
  On Error GoTo 0

End Function

Code: 
Public Function TestForApp()
MsgBox ApplicationIsAvailable("Outlook.application")
End Function
 
For what it's worth I have Office 365 which has Access 2013 and Outlook 2013 and your code shows True for both "Outlook.application" and "Outlook.Application"
 
@BlueIshDan - just left the office. Will try uppercase tomorrow

@sneuberg - Could be because you have the same version for both then.
I hope someone with a 'mixed' setup post their findings. ..
 
I do not believe a2003 will work with outlook 2013.

I use vbmapi from everything access, and that will not work either.
 
BlueIshDan said:
try

On Error GoTo ErrorLabel

ErrorLabel:
MsgBox err.Description
Click to expand...

When I try the above I get the following msg:
"ActiveX component can't create object"

Does this help?

PS: Uppercase suggestion did not do anything
 
Did you reboot your machine?

It can't be a versioning issue, since "Outlook.Application" does not specify a version. An attempt will be made to instantiate whatever version is registered with the OS, and if the object can be created, then it can.

You can shorten your procedure, with no loss of effectiveness, and to me an improvement in clarity, if you do . . .
Code: 
Function IsAppCreatable(Class As String) As Boolean
On Error Resume Next
    IsAppCreatable = Not CreateObject(Class) Is Nothing
End Function
 
@MarkK - Thanks - I tried your code but also got 'false' in reply

Any other way of checking for Outlook maybe using a API
 
@MarkK - Yes I did reboot. Also tried "Microsoft Outlook.Application" since that is the name on the taskbar and also the Process name in TaskManager

Otherwise I must loop through all Folders eg: Office12, Office 14, Office 15 etc and check for "Outlook.exe" file name
 
Sorry for all the single posts but I tried:
Access.Application and got true (running Access2003)
Word.Application and got true (running Word 2013)
Excel.Application and got true (running Excel 2013)

So it is just Outlook that is sticky. Also tried MSOutlook

Is there a way to display all apps to get maybe the correct name (will be a long list...)
 
did you note my observation in #6

100% - A2003 will not work with A2013
 
@husky - sorry man - too many posts at once :)
I hear what you saying. So you recon if you running Access 2003 you cannot test to see if the Client has any Outlook other than 2003 installed?
If that is the case (which MarkK disagrees with in #8) these should still be a way to test for the existence of Outlook on the machine - no matter what version. Not?
 
I'm using this in an .mdb file to check if outlook is running and it works with Outlook 2013 , admittedly the mdb is being run via 2010 runtime... ?
Code: 
Public Function IsOutlookOpen() As Boolean
Dim oOutLook As Object

On Error Resume Next
    
    Set oOutLook = GetObject(, "Outlook.application")
    
    If oOutLook Is Nothing Then
        IsOutlookOpen = False
    Else
        IsOutlookOpen = True
    End If
    
End Function
Not sure if it's of any help.
 
@Minty - thanks - I tried it but with the same result ("False").
Maybe the VBA is limited to only checking the same version as Husky suggested
Sure there must be a API does doesn't care about this

If I remove the error checking I get the same thing on all scripts tried above.
"ActiveX component can't create object"
Not sure if that is the clue since any error will result in a 'false' boolean
 
Hi all,
OK - I've stripped some of the lines from the code in the above link in #15 to come up with an ugly piece of code that does the trick.
Maybe some of you can test it. Should just say "True" if "Microsoft Outlook" is found in the Installed Programs of the local machine.
Refer to line #14 in the "GetAddRemove function.
As I mentioned - I just ripped and quickly changed the code. Should be able to simplify it in time.
I just wanted to proof to myself that it must be possible to check for Outlook

Code: 
Option Compare Database

Private sFileName

Sub GetInstalledSoftWare()

StrComputer = Trim(StrComputer)
If StrComputer = "" Then StrComputer = "."
Dim sCompName: sCompName = GetProbedID(StrComputer)
Dim sFileName
sFileName = "Software.txt"
Dim s: s = GetAddRemove(StrComputer)
If WriteFile(s, sFileName) Then
End If
End Sub

Function GetAddRemove(sComp)
  'Function credit to Torgeir Bakken
  Dim cnt, oReg, sBaseKey, iRC, aSubKeys
  Const HKLM = &H80000002  'HKEY_LOCAL_MACHINE
  Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
              sComp & "/root/default:StdRegProv")
  sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
  iRC = oReg.EnumKey(HKLM, sBaseKey, aSubKeys)
  Dim sKey, sValue, sTmp, sVersion, sDateValue, sYr, sMth, sDay
  For Each sKey In aSubKeys
    iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, "DisplayName", sValue)
    If iRC <> 0 Then
      oReg.GetStringValue HKLM, sBaseKey & sKey, "QuietDisplayName", sValue
    End If
    If Left(sValue, 17) = "Microsoft Outlook" Then MsgBox "True"
    If sValue <> "" Then
      iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
                                "DisplayVersion", sVersion)
      If sVersion <> "" Then
        sValue = sValue & vbTab & "Ver: " & sVersion
      Else
        sValue = sValue & vbTab
      End If
      iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
                                "InstallDate", sDateValue)
      If sDateValue <> "" Then
        sYr = Left(sDateValue, 4)
        sMth = Mid(sDateValue, 5, 2)
        sDay = Right(sDateValue, 2)
        'some Registry entries have improper date format
        On Error Resume Next
        sDateValue = DateSerial(sYr, sMth, sDay)
        On Error GoTo 0
        If sDateValue <> "" Then
          sValue = sValue & vbTab & "Installed: " & sDateValue
        End If
      End If
      sTmp = sTmp & sValue & vbCrLf
    cnt = cnt + 1
    End If
  Next
  sTmp = BubbleSort(sTmp)
  GetAddRemove = "INSTALLED SOFTWARE (" & cnt & ") - " & sCompName & _
                 " - " & Now() & vbCrLf & vbCrLf & sTmp
End Function

Function BubbleSort(sTmp)
  'cheapo bubble sort
  Dim aTmp, i, j, temp
  aTmp = Split(sTmp, vbCrLf)
  For i = UBound(aTmp) - 1 To 0 Step -1
    For j = 0 To i - 1
      If LCase(aTmp(j)) > LCase(aTmp(j + 1)) Then
        temp = aTmp(j + 1)
        aTmp(j + 1) = aTmp(j)
        aTmp(j) = temp
      End If
    Next
  Next
  BubbleSort = Join(aTmp, vbCrLf)
End Function

Function GetProbedID(sComp)
  Dim objWMIService, colItems, objItem
  Set objWMIService = GetObject("winmgmts:\\" & sComp & "\root\cimv2")
  Set colItems = objWMIService.ExecQuery("Select SystemName from " & _
                                         "Win32_NetworkAdapter", , 48)
  For Each objItem In colItems
    GetProbedID = objItem.SystemName
  Next
End Function

Function WriteFile(sData, sFileName)
  Dim fso, OutFile, bWrite
  bWrite = True
  Set fso = CreateObject("Scripting.FileSystemObject")
  On Error Resume Next
  Set OutFile = fso.OpenTextFile(sFileName, 2, True)
  'Possibly need a prompt to close the file and one recursion attempt.
  If Err = 70 Then
    WScript.Echo "Could not write to file " & sFileName & ", results " & _
                 "not saved." & vbCrLf & vbCrLf & "This is probably " & _
                 "because the file is already open."
    bWrite = False
  ElseIf Err Then
    WScript.Echo Err & vbCrLf & Err.Description
    bWrite = False
  End If
  On Error GoTo 0
  If bWrite Then
    OutFile.WriteLine (sData)
    OutFile.Close
  End If
  Set fso = Nothing
  Set OutFile = Nothing
  WriteFile = bWrite
End Function
 
http://stackoverflow.com/questions/30841320/activex-component-cant-create-object-for-outlook-vba

Do you have the Click2Run edition of Office installed on the problematic PC?

The Click2Run edition of Office 2010 doesn't support automation. See Office 2010 Click-to-Run compatibility with add-ins for more information. Also you may find the How to: Verify Whether Outlook Is a Click-to-Run Application on a Computer article.

See You receive run-time error 429 when you automate Office applications for more information.
Click to expand...
 
@minty. I tested A2013 with O2013, no problems. I haven't tested A2010, but I presume it will work from your tests

I just think that maybe MS changed the way outlook works in Office2013 and A2003 is no longer compatible. As I say, I use everythingaccess vbmapi solution, and that fails as well.

fwiw, I have now added this line to my initialisation code in my email class module

Set objapp = CreateObject("Outlook.Application") ' Don't specify version

it works in A2013, and fails in A2003.
If it fails I prevent email sending in the app.
 
Thanks to all for your input.
I think this matter is now closed with the conclusion that the method will not work in A2003.
Will look at upgrading on my side.

Forgot to add this:
The reason for my OP had to do with setting reminders from within A2003 writing to Outlook Task Scheduler and not with sending emails which still works 100% using the SendTo command
So @Husky - there might be no reason to block email sending?

Regards
 
Last edited:
You must log in or register to reply here.

Similar threads

A
Solved VBA code for deleting Outlook 'Appointments' lying within a specified date range
Replies
8
Views
621
Gasman
Gasman
Jason Lee Hayes
Solved Open Outlook & check for new mail where search criteria is applied to the email subject line
Replies
19
Views
885
Jason Lee Hayes
Jason Lee Hayes
B
Outlook - Filtered Unread, Server duplicate emails & think Unread = False not work so errors
Replies
6
Views
596
bignose2
B
jwcolby54
Building a table for my book
Replies
15
Views
426
jwcolby54
jwcolby54
H
Code for sending email 'transport' error
Replies
11
Views
1,121
isladogs
isladogs

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom