"RWC" <rc******************@hemmingway.com> wrote in message
news:Ybpie.1389236$8l.321516@pd7tw1no...
Hi Folks,
I'm looking for a way to determine if the client machine has access
installed and if so, what version. The reason I need this is to determine
(programatically) if the Access Runtime is required to be installed and if
not, which version of the program database needs to be installed with the
current version of Access. (hope that makes sense).
If anyonoe could point me in the right direction, I'd really appreciate
it.
Thanks in advance!
Rick
My logic is that since normally mdb is associated with access, we can find
the application associated with mdb then find the file version. I have not
tested this code but give it a shot:
' Calling code in form
exePath = GetAccessPath
exeversion = GetVersion(Trim(exePath))
'===module level
Option Explicit
Public gAccessExists As Boolean
Public gAccessPath As String
Public Declare Function FindExecutable Lib "shell32" _
Alias "FindExecutableA" _
(ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal sResult As String) As Long
Public Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" _
(ByVal nSize As Long, _
ByVal lpBuffer As String) As Long
Public Const MAX_PATH As Long = 260
Public Const ERROR_FILE_NO_ASSOCIATION As Long = 31
Public Const ERROR_FILE_NOT_FOUND As Long = 2
Public Const ERROR_PATH_NOT_FOUND As Long = 3
Public Const ERROR_FILE_SUCCESS As Long = 32 > is good
Public Const ERROR_BAD_FORMAT As Long = 11
Private Const ERROR_SUCCESS As Long = 0
Private Type FIXEDFILEINFO
dwSignature As Long
dwStrucVersionl As Integer
dwStrucVersionh As Integer
dwFileVersionMSl As Integer
dwFileVersionMSh As Integer
dwFileVersionLSl As Integer
dwFileVersionLSh As Integer
dwProductVersionMSl As Integer
dwProductVersionMSh As Integer
dwProductVersionLSl As Integer
dwProductVersionLSh As Integer
dwFileFlagsMask As Long
dwFileFlags As Long
dwFileOS As Long
dwFileType As Long
dwFileSubtype As Long
dwFileDateMS As Long
dwFileDateLS As Long
End Type
Private 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
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias
"GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As
Long) As Long
Private Declare Function VerQueryValue Lib "Version.dll" Alias
"VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As
Any, puLen As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As
Any, ByVal Source As Long, ByVal length As Long)
' Find what is associated with mdb
Public Function GetmdbAssociation(dwFlagReturned As Long) As String
Dim sTempFolder
Dim hfile
Dim sResult As String
'get the user's temp folder
sTempFolder = GetTempDir()
'create a dummy mdb file in the temp dir
hfile = FreeFile
Open sTempFolder & "dummy.mdb" For Output As #hfile
Close
'get the file path & name associated with the file
sResult = Space$(MAX_PATH)
dwFlagReturned = FindExecutable("dummy.mdb", sTempFolder, sResult)
'clean up
Kill sTempFolder & "dummy.mdb"
'return result
GetmdbAssociation = TrimNull(sResult)
End Function
Public Function TrimNull(item As String)
Dim pos As Integer
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If
End Function
Public Function GetTempDir() As String
Dim nSize As Long
Dim tmp As String
tmp = Space$(MAX_PATH)
nSize = Len(tmp)
Call GetTempPath(nSize, tmp)
GetTempDir = TrimNull(tmp)
End Function
Public Function GetAccessPath() As String
Dim b$
Dim success As Long
'success is passed and filled in the routine
b$ = GetmdbAssociation(success)
'possible return values from the call
'returned in success
Select Case success
'the call succeeded
Case Is >= ERROR_FILE_SUCCESS '>32 good
gAccessExists = True
'other possible return values
'Case ERROR_FILE_NO_ASSOCIATION
'Case ERROR_FILE_NOT_FOUND
'Case ERROR_PATH_NOT_FOUND
'Case ERROR_BAD_FORMAT
gAccessPath = b$
Case Else
gAccessExists = False
End Select
GetAccessPath = b$
End Function
Public Function GetVersion(sPath) 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 FIXEDFILEINFO
Dim lVerbufferLen As Long
On Error GoTo GetFileVersion_Error
'*** Get size ****
lBufferLen = GetFileVersionInfoSize(sPath, lDummy)
If lBufferLen < 1 Then
GetVersion = ""
Exit Function
End If
'**** Store info into struct ****
ReDim sBuffer(lBufferLen)
rc = GetFileVersionInfo(sPath, 0&, lBufferLen, sBuffer(0))
rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)
' a very very long line below
GetVersion = Format$(udtVerBuffer.dwFileVersionMSh) & "." &
Format$(udtVerBuffer.dwFileVersionMSl) & "." &
Format$(udtVerBuffer.dwFileVersionLSh) & "." &
Format$(udtVerBuffer.dwFileVersionLSl)
On Error GoTo 0
Exit Function
GetFileVersion_Error:
GetVersion = ""
End Function
