VB - How to tell if an Office component is installed

Printable View

If you want to know whether or not a particular Office component is available before attempting automation...

VB Code:

Private Enum OfficeComponents
    Word = 0
    Excel = 1
    PowerPoint = 2
    Access = 3
End Enum
 
Private Function IsOfficeComponentInstalled(Component As OfficeComponents) As Boolean
Dim s As String
Dim o As Object
 
    Select Case Component
        Case Word:       s = "Word"
        Case Excel:      s = "Excel"
        Case PowerPoint: s = "PowerPoint"
        Case Access:     s = "Access"
    End Select
    
On Error Resume Next
    Set o = CreateObject(s & ".Application")
    IsOfficeComponentInstalled = Not (o Is Nothing)
    
    Set o = Nothing
    
End Function
 
Private Sub Command1_Click()
 
    MsgBox IsOfficeComponentInstalled(Word)
    MsgBox IsOfficeComponentInstalled(Excel)
    MsgBox IsOfficeComponentInstalled(PowerPoint)
    MsgBox IsOfficeComponentInstalled(Access)
 
End Sub

Mar 24th, 2003, 09:25 AM
blaff
I've written a little Installation Test-Program, to check a customer PC for installed components.

I check several dlls, activex-controls and office components and the last part is nearly the same as your tip. Except two lines
VB Code:
```
On Error Resume Next
    Set o = CreateObject(s & ".Application")
    IsOfficeComponentInstalled = Not (o Is Nothing)
    
    o.quit false
    o.quit
    
    Set o = Nothing
```
some apps may hang if you don't terminate them the way they want!
Btw.: this works with visio and MapPoint, too!
Mar 24th, 2003, 09:32 AM
crptcblade
Quote:
Originally posted by blaff

VB Code:

'...
o.quit false
o.quit
'...
Excellent. I would never have guessed that.

Check the installed version

If you want to check the installed version (build from sveral code snippets all over the web):

VB Code:

Private Function IsOfficeComponentInstalled(Component As OfficeComponents, byref blnCreated as Boolean) As String
Dim s As String
Dim o As Object
sim strFname as String
 
    blnCreated = False
    
    Select Case Component
        Case Word:       s = "Word"
        Case Excel:      s = "Excel"
        Case PowerPoint: s = "PowerPoint"
        Case Access:     s = "Access"
    End Select
    
    strFname =  GetFileFromProgID(s)
    IsOfficeComponentInstalled=FileVerInfo(strFname)
 
On Error Resume Next
    Set o = CreateObject(s & ".Application")
    blnCreated = Not (o Is Nothing)
    
    Set o = Nothing
    o.quit false
    o.quit
    
End Function

with one module for Version Infos:

VB Code:

Option Explicit
Type VS_FIXEDFILEINFO
 
   dwSignature As Long
   dwStrucVersionl As Integer     '  e.g. = &h0000 = 0
   dwStrucVersionh As Integer     '  e.g. = &h0042 = .42
   dwFileVersionMSl As Integer    '  e.g. = &h0003 = 3
   dwFileVersionMSh As Integer    '  e.g. = &h0075 = .75
   dwFileVersionLSl As Integer    '  e.g. = &h0000 = 0
   dwFileVersionLSh As Integer    '  e.g. = &h0031 = .31
   dwProductVersionMSl As Integer '  e.g. = &h0003 = 3
   dwProductVersionMSh As Integer '  e.g. = &h0010 = .1
   dwProductVersionLSl As Integer '  e.g. = &h0000 = 0
   dwProductVersionLSh As Integer '  e.g. = &h0031 = .31
   dwFileFlagsMask As Long        '  = &h3F for version "0.42"
   dwFileFlags As Long            '  e.g. VFF_DEBUG Or VFF_PRERELEASE
   dwFileOS As Long               '  e.g. VOS_DOS_WINDOWS16
   dwFileType As Long             '  e.g. VFT_DRIVER
   dwFileSubtype As Long          '  e.g. VFT2_DRV_KEYBOARD
   dwFileDateMS As Long           '  e.g. 0
   dwFileDateLS As Long           '  e.g. 0
End Type
 
Declare Function GetFileVersionInfo Lib "version.dll" Alias _
   "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal _
   dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Declare Function GetFileVersionInfoSize Lib "version.dll" Alias _
   "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, _
   lpdwHandle As Long) As Long
Declare Function VerQueryValue Lib "version.dll" Alias _
   "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, _
   lplpBuffer As Any, puLen As Long) As Long
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
   (dest As Any, ByVal source As Long, ByVal length As Long)
Declare Function GetSystemDirectory Lib "kernel32" Alias _
   "GetSystemDirectoryA" _
   (ByVal path As String, ByVal cbBytes As Long) As Long
 
' ===== From Win32 Ver.h =================
' ----- VS_VERSION.dwFileFlags -----
Public Const VS_FFI_SIGNATURE = &HFEEF04BD
Public Const VS_FFI_STRUCVERSION = &H10000
Public Const VS_FFI_FILEFLAGSMASK = &H3F&
 
' ----- VS_VERSION.dwFileFlags -----
Public Const VS_FF_DEBUG = &H1
Public Const VS_FF_PRERELEASE = &H2
Public Const VS_FF_PATCHED = &H4
Public Const VS_FF_PRIVATEBUILD = &H8
Public Const VS_FF_INFOINFERRED = &H10
Public Const VS_FF_SPECIALBUILD = &H20
 
' ----- VS_VERSION.dwFileOS -----
Public Const VOS_UNKNOWN = &H0
Public Const VOS_DOS = &H10000
Public Const VOS_OS216 = &H20000
Public Const VOS_OS232 = &H30000
Public Const VOS_NT = &H40000
Public Const VOS__BASE = &H0
Public Const VOS__WINDOWS16 = &H1
Public Const VOS__PM16 = &H2
Public Const VOS__PM32 = &H3
Public Const VOS__WINDOWS32 = &H4
 
Public Const VOS_DOS_WINDOWS16 = &H10001
Public Const VOS_DOS_WINDOWS32 = &H10004
Public Const VOS_OS216_PM16 = &H20002
Public Const VOS_OS232_PM32 = &H30003
Public Const VOS_NT_WINDOWS32 = &H40004
 
 
' ----- VS_VERSION.dwFileType -----
Public Const VFT_UNKNOWN = &H0
Public Const VFT_APP = &H1
Public Const VFT_DLL = &H2
Public Const VFT_DRV = &H3
Public Const VFT_FONT = &H4
Public Const VFT_VXD = &H5
Public Const VFT_STATIC_LIB = &H7
 
' ----- VS_VERSION.dwFileSubtype for VFT_WINDOWS_DRV -----
Public Const VFT2_UNKNOWN = &H0
Public Const VFT2_DRV_PRINTER = &H1
Public Const VFT2_DRV_KEYBOARD = &H2
Public Const VFT2_DRV_LANGUAGE = &H3
Public Const VFT2_DRV_DISPLAY = &H4
Public Const VFT2_DRV_MOUSE = &H5
Public Const VFT2_DRV_NETWORK = &H6
Public Const VFT2_DRV_SYSTEM = &H7
Public Const VFT2_DRV_INSTALLABLE = &H8
Public Const VFT2_DRV_SOUND = &H9
Public Const VFT2_DRV_COMM = &HA
 
Private Const dhcMaxPath = 260
 
Public Function tt_FileVerInfo(FullFileName As String) As String
   Dim strMessage As String
   Dim rc                As Long
   Dim lDummy            As Long
   Dim sBuffer()         As Byte
   Dim lBufferLen        As Long
   Dim lVerPointer       As Long
   Dim udtVerBuffer      As VS_FIXEDFILEINFO
   Dim lVerbufferLen     As Long
   
   '*** Get size ****
   lBufferLen = GetFileVersionInfoSize(FullFileName, lDummy)
   If lBufferLen < 1 Then
    tt_FileVerInfo = "Not available"
    Exit Function
   End If
   
   '**** Store info to udtVerBuffer struct ****
   ReDim sBuffer(lBufferLen)
   rc = GetFileVersionInfo(FullFileName, 0&, lBufferLen, sBuffer(0))
   rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
   MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)
   
   '**** Determine Product Version number ****
'   tt_ProdVerInfo = Format$(udtVerBuffer.dwProductVersionMSh) & "." & _
'      Format$(udtVerBuffer.dwProductVersionMSl) & "." & _
'      Format$(udtVerBuffer.dwProductVersionLSh) & "." & _
'      Format$(udtVerBuffer.dwProductVersionLSl)
   tt_FileVerInfo = Format$(udtVerBuffer.dwFileVersionMSh) & "." & _
      Format$(udtVerBuffer.dwFileVersionMSl) & "." & _
      Format$(udtVerBuffer.dwFileVersionLSh) & "." & _
      Format$(udtVerBuffer.dwFileVersionLSl)
 
End Function
 
 
Function tt_SystemDirectory() As String
    ' Retrieve the system directory.
    Dim strBuffer As String
    Dim lngLen As Long
    
    strBuffer = Space(dhcMaxPath)
    lngLen = dhcMaxPath
    
    lngLen = GetSystemDirectory(strBuffer, lngLen)
    ' If the path is longer than dhcMaxPath, then
    ' lngLen contains the correct length. Resize the
    ' buffer and try again.
    If lngLen > dhcMaxPath Then
        strBuffer = Space(lngLen)
        lngLen = GetSystemDirectory(strBuffer, lngLen)
    End If
    
    tt_SystemDirectory = Left$(strBuffer, lngLen)
 
End Function
 
Function GetFileFromProgID(ByVal ProgID As String) As String
    Dim clsid As String
    Const HKEY_CLASSES_ROOT = &H80000000
 
    ' get the CLSID from the registry, exit if not found
    clsid = GetRegistryValue(HKEY_CLASSES_ROOT, ProgID & "\CLSID", "")
    If Len(clsid) = 0 Then Exit Function
    
    ' try to read the HKEY_CLASSES_ROOT\CLSID\{...}\InProcServer32 value
    GetFileFromProgID = GetRegistryValue(HKEY_CLASSES_ROOT, _
        "CLSID\" & clsid & "\InProcServer32", "")
    ' exit if found
    If Len(GetFileFromProgID) Then Exit Function
    
    ' try to read the HKEY_CLASSES_ROOT\CLSID\{...}\LocalServer32 value
    GetFileFromProgID = GetRegistryValue(HKEY_CLASSES_ROOT, _
        "CLSID\" & clsid & "\LocalServer32", "")
    
End Function

and one Module for the Registry Access

following in the next message ;)

Registry Access

Voilà:

VB Code:

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
    ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As _
    Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
    "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
    ByVal lpReserved As Long, lpType As Long, lpData As Any, _
    lpcbData As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
    Any, source As Any, ByVal numBytes As Long)
 
Const KEY_READ = &H20019  ' ((READ_CONTROL Or KEY_QUERY_VALUE Or
                          ' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not
                          ' SYNCHRONIZE))
 
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Const ERROR_MORE_DATA = 234
 
' Read a Registry value
'
' Use KeyName = "" for the default value
' If the value isn't there, it returns the DefaultValue
' argument, or Empty if the argument has been omitted
'
' Supports DWORD, REG_SZ, REG_EXPAND_SZ, REG_BINARY and REG_MULTI_SZ
' REG_MULTI_SZ values are returned as a null-delimited stream of strings
' (VB6 users can use SPlit to convert to an array of string)
 
Function GetRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _
    ByVal ValueName As String, Optional DefaultValue As Variant) As Variant
    Dim handle As Long
    Dim resLong As Long
    Dim resString As String
    Dim resBinary() As Byte
    Dim length As Long
    Dim retVal As Long
    Dim valueType As Long
    
    ' Prepare the default result
    GetRegistryValue = IIf(IsMissing(DefaultValue), Empty, DefaultValue)
    
    ' Open the key, exit if not found.
    If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then
        Exit Function
    End If
    
    ' prepare a 1K receiving resBinary
    length = 1024
    ReDim resBinary(0 To length - 1) As Byte
    
    ' read the registry key
    retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _
        length)
    ' if resBinary was too small, try again
    If retVal = ERROR_MORE_DATA Then
        ' enlarge the resBinary, and read the value again
        ReDim resBinary(0 To length - 1) As Byte
        retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _
            length)
    End If
    
    ' return a value corresponding to the value type
    Select Case valueType
        Case REG_DWORD
            CopyMemory resLong, resBinary(0), 4
            GetRegistryValue = resLong
        Case REG_SZ, REG_EXPAND_SZ
            ' copy everything but the trailing null char
            resString = Space$(length - 1)
            CopyMemory ByVal resString, resBinary(0), length - 1
            GetRegistryValue = resString
        Case REG_BINARY
            ' resize the result resBinary
            If length <> UBound(resBinary) + 1 Then
                ReDim Preserve resBinary(0 To length - 1) As Byte
            End If
            GetRegistryValue = resBinary()
        Case REG_MULTI_SZ
            ' copy everything but the 2 trailing null chars
            resString = Space$(length - 2)
            CopyMemory ByVal resString, resBinary(0), length - 2
            GetRegistryValue = resString
        Case Else
            RegCloseKey handle
            Err.Raise 1001, , "Unsupported value type"
    End Select
    
    ' close the registry key
    RegCloseKey handle
End Function