"RWC" <rc************ ******@hemmingw ay.com> wrote in message
news:Ybpie.1389 236$8l.321516@p d7tw1no...
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
(programaticall y) 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 "FindExecutable A" _
(ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal sResult As String) As Long
Public Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPat hA" _
(ByVal nSize As Long, _
ByVal lpBuffer As String) As Long
Public Const MAX_PATH As Long = 260
Public Const ERROR_FILE_NO_A SSOCIATION 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_SUCC ESS As Long = 32 > is good
Public Const ERROR_BAD_FORMA T As Long = 11
Private Const ERROR_SUCCESS As Long = 0
Private Type FIXEDFILEINFO
dwSignature As Long
dwStrucVersionl As Integer
dwStrucVersionh As Integer
dwFileVersionMS l As Integer
dwFileVersionMS h As Integer
dwFileVersionLS l As Integer
dwFileVersionLS h As Integer
dwProductVersio nMSl As Integer
dwProductVersio nMSh As Integer
dwProductVersio nLSl As Integer
dwProductVersio nLSh 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 GetFileVersionI nfo Lib "Version.dl l" Alias
"GetFileVersion InfoA" (ByVal lptstrFilename As String, ByVal dwhandle As
Long, ByVal dwlen As Long, lpData As Any) As Long
Private Declare Function GetFileVersionI nfoSize Lib "Version.dl l" Alias
"GetFileVersion InfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As
Long) As Long
Private Declare Function VerQueryValue Lib "Version.dl l" Alias
"VerQueryValueA " (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As
Any, puLen As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMem ory" (dest As
Any, ByVal Source As Long, ByVal length As Long)
' Find what is associated with mdb
Public Function GetmdbAssociati on(dwFlagReturn ed 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
GetmdbAssociati on = TrimNull(sResul t)
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(nSi ze, 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$ = GetmdbAssociati on(success)
'possible return values from the call
'returned in success
Select Case success
'the call succeeded
Case Is >= ERROR_FILE_SUCC ESS '>32 good
gAccessExists = True
'other possible return values
'Case ERROR_FILE_NO_A SSOCIATION
'Case ERROR_FILE_NOT_ FOUND
'Case ERROR_PATH_NOT_ FOUND
'Case ERROR_BAD_FORMA T
gAccessPath = b$
Case Else
gAccessExists = False
End Select
GetAccessPath = b$
End Function
Public Function GetVersion(sPat h) 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 = GetFileVersionI nfoSize(sPath, lDummy)
If lBufferLen < 1 Then
GetVersion = ""
Exit Function
End If
'**** Store info into struct ****
ReDim sBuffer(lBuffer Len)
rc = GetFileVersionI nfo(sPath, 0&, lBufferLen, sBuffer(0))
rc = VerQueryValue(s Buffer(0), "\", lVerPointer, lVerbufferLen)
MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffe r)
' a very very long line below
GetVersion = Format$(udtVerB uffer.dwFileVer sionMSh) & "." &
Format$(udtVerB uffer.dwFileVer sionMSl) & "." &
Format$(udtVerB uffer.dwFileVer sionLSh) & "." &
Format$(udtVerB uffer.dwFileVer sionLSl)
On Error GoTo 0
Exit Function
GetFileVersion_ Error:
GetVersion = ""
End Function
