Check if program installed (specifically Google Earth)

[sous2817]

Hello everyone,

I'm tinkering with Google Earth and I'm struggling to check if the application is installed on the user's machine. I know when you go to a google earth page and you don't have it installed, you're given the option to install it. The problem with that is, you need to have admin rights in order to install, which we don't have on our work machines. My goal is to capture the fact that they don't have it installed at macro execution time rather than wait for the dialog box to open on a website, ask if they'd like to install google earth, then have it crap out during installation.

So if there's some error check at the start, I can handle the issue before it gets to the "installation failed" message.

I found this bit of code online:

Function ApplicationIsAvailable(ApplicationClassName As String) As Boolean
' returns True if the application is available
' example: If Not ApplicationIsAvailable("Outlook.Application") Then Exit Sub
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

which works if you know the application name. Unfortunately, it's not as simple as replacing "Outlook.Application" with "GoogleEarth.Application".

So I'm wondering if anyone has any ideas on how to test if an application is installed...

Thanks in advance,
sous

 

[shg]

I don't know how to see if it's installed. Here's a way to see if there is a reference set:

Sub x()
    Debug.Print HasRef("{3476FAB2-687F-4EA6-9AC2-88D72DC7D7FC}")
End Sub
 
Function HasRef(sGUID) As Boolean
    Dim oRef As Reference
 
    With ThisWorkbook.VBProject
        For Each oRef In .References
            If oRef.GUID = sGUID Then
                HasRef = True
                Exit For
            End If
        Next oRef
    End With
End Function

Requires a reference to MS VBA Extensibility.

 

[sous2817]

Thanks for the code shg! I'll give it a go shortly.

 

[sous2817]

Hello shg,

Works as expected. Thanks again!

 

[sous2817]

well it works until I try it on a computer that doens't have the program installed. The reference is still set so it returns a "true"...back to square 1.

 

[sous2817]

Think I have it sorted:

Sub test()

Dim b As Boolean

b = RegKeyExists("HKEY_CURRENT_USER\Software\Google\GoogleEarthPlugin\")
MsgBox b
End Sub


Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object

  On Error GoTo ErrorHandler
  'access Windows scripting
  Set myWS = CreateObject("WScript.Shell")
  'try to read the registry key
  myWS.RegRead i_RegKey
  'key was found
  RegKeyExists = True
  Exit Function
  
ErrorHandler:
  'key was not found
  RegKeyExists = False
End Function

Original source is here: http://vba-corner.livejournal.com/3054.html