MartyConnelly
martyconnelly at shaw.ca
Mon Apr 3 15:35:51 CDT 2006
You might get this with ArcInfo as it uses Access as one of its data
engines,
so you might get a bum DAO reference on an install, don't know about AutoCAD
AutoCAD might also might forece an install of an old common control.
This might help
Stick this code in an mde and run on the odd machine.
It will printout the possible reference differences (version number,
path and name).
Or rewrite this inorder to dump to a text file like
'kill file as necessary
Open c:\temp\outputref.txt For Output As #1
Print #1, ReferencePropertiesList
Close #1
Run it from autoexec macro, code should be fully disambiguated to avoid
any initial reference check
before running. ie VBA.MsgBox, Access.Reference and VBA.Len, VarPtr
might not be available in lower versions of Access
might be a replacement on www.mvps.org/access
Place in 3 seperate modules.
'http://allenbrowne.com/ser-38.html
'http://www.accessmvp.com/djsteele/AccessReferenceErrors.html'
'I got tired of trying to decipher the full path name to a DLL in Tools:
'Reference Window. In Access 97 it cuts off the path filename at about 30
'chars. To get the a list of the all the filenames and paths for your
'external references, run the routine below it places all the references
'into a string suitable for dropping into a text box. As an afterthought I
'added some code to give the actual version number from the dll or ocx file
'etc. This might be useful in an MDE to track if the user has correct
'version number of DAO ADO etc. installed. Place in About popup window.
' It only seems to work some of the time if a reference is missing, seems
'to depend on installation order. So it might not help in all missing
references.
Function ReferencePropertiesList() As String
'list all references in a MDB and place in a string
Dim ref As Access.Reference
Dim strList As String
strList = "Reference Properties:" & vbCrLf & vbCrLf
For Each ref In Access.References
' Check for ActiveX type files
'Check for Broken Properties
If ref.IsBroken = False Then
strList = strList & " Name: " & ref.Name & vbCrLf
strList = strList & " FullPath: " & ref.FullPath & vbCrLf
strList = strList & " Version: " & ref.Major & "." & ref.Minor & _
vbCrLf
'skip these two calls if detail not needed
strList = strList & " Description: " & _
GetFileDescription(ref.FullPath) & vbCrLf
strList = strList & " Version No: " & _
FileVersionNo(ref.FullPath) & _
vbCrLf & vbCrLf
Else
strList = strList & " GUIDs of broken references:" & vbCrLf
strList = strList & " " & ref.Guid & vbCrLf & vbCrLf
End If
'VBA.MsgBox GetFileDescription(ref.FullPath) & " - " &
FileVersionNo(ref.FullPath)
Next ref
Debug.Print strList
ReferencePropertiesList = strList
End Function
------------------ module 2
'usage: file description
'Private Sub Command1_Click()
' MsgBox GetFileDescription("c:\windows\system\shell32.dll")
'End Sub
'Declarations:
Private Declare Function GetLocaleInfoA Lib "kernel32.dll" (ByVal lLCID As _
Long, ByVal lLCTYPE As Long, ByVal strLCData As String, ByVal lDataLen As _
Long) As Long
Private Declare Sub lstrcpyn Lib "kernel32.dll" (ByVal strDest As String, _
ByVal strSrc As Any, ByVal lBytes As Long)
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" _
Alias "GetFileVersionInfoSizeA" (ByVal sFile As String, lpLen As Long)
As Long
Private Declare Function GetFileVersionInfo Lib "Version.dll" _
Alias "GetFileVersionInfoA" (ByVal sFile As String, ByVal lpIgnored As _
Long, ByVal lpSize As Long, ByVal lpBuf As Long) As Long
Private Declare Function VerQueryValue Lib "Version.dll" _
Alias "VerQueryValueA" (ByVal lpBuf As Long, ByVal szReceive As String, _
lpBufPtr As Long, lLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal ByteLen As Long)
Private Declare Function GetUserDefaultLCID Lib "kernel32.dll" () As Long
'Functions:
Public Function StringFromBuffer(buffer As String) As String
Dim nPos As Long
nPos = VBA.InStr(buffer, vbNullChar)
If nPos > 0 Then
StringFromBuffer = VBA.Left$(buffer, nPos - 1)
Else
StringFromBuffer = buffer
End If
End Function
Public Function GetFileDescription(ByVal sFile As String) As String
Dim lVerSize As Long
Dim lTemp As Long
Dim lRet As Long
Dim bInfo() As Byte
Dim lpBuffer As Long
Dim sDesc As String
Dim sKEY As String
lVerSize = GetFileVersionInfoSize(sFile, lTemp)
ReDim bInfo(lVerSize)
If lVerSize > 0 Then
lRet = GetFileVersionInfo(sFile, lTemp, lVerSize, VBA.VarPtr(bInfo(0)))
If lRet <> 0 Then
sKEY = GetNLSKey(bInfo)
lRet = VerQueryValue(VBA.VarPtr(bInfo(0)), sKEY &
"\FileDescription", lpBuffer, lVerSize)
If lRet <> 0 Then
sDesc = VBA.Space$(lVerSize)
lstrcpyn sDesc, lpBuffer, lVerSize
GetFileDescription = StringFromBuffer(sDesc)
End If
End If
End If
End Function
Public Function GetNLSKey(byteVerData() As Byte) As String
Static strLANGCP As String
Dim lpBufPtr As Long
Dim strNLSKey As String
Dim fGotNLSKey As Integer
Dim intOffset As Integer
Dim lVerSize As Long
Dim lTmp As Long
Dim lBufLen As Long
Dim lLCID As Long
Dim strTmp As String
On Error GoTo GNLSKCleanup
If VerQueryValue(VBA.VarPtr(byteVerData(0)),
"\VarFileInfo\Translation", lpBufPtr, lVerSize) <> 0 Then
If VBA.Len(strLANGCP) = 0 Then
lLCID = GetUserDefaultLCID()
If lLCID > 0 Then
strTmp = VBA.Space$(8)
GetLocaleInfoA lLCID, 11, strTmp, 8
strLANGCP = StringFromBuffer(strTmp)
Do While VBA.Len(strLANGCP) < 4
strLANGCP = "0" & strLANGCP
Loop
GetLocaleInfoA lLCID, 9, strTmp, 8
strLANGCP = StringFromBuffer(strTmp) & strLANGCP
Do While VBA.Len(strLANGCP) < 8
strLANGCP = "0" & strLANGCP
Loop
End If
End If
If VerQueryValue(VBA.VarPtr(byteVerData(0)), strLANGCP, lTmp,
lBufLen) <> 0 Then
strNLSKey = strLANGCP
Else
For intOffset = 0 To lVerSize - 1 Step 4
CopyMemory lTmp, ByVal lpBufPtr + intOffset, 4
strTmp = VBA.Hex$(lTmp)
Do While VBA.Len(strTmp) < 8
strTmp = "0" & strTmp
Loop
strNLSKey = "\StringFileInfo\" & Right$(strTmp, 4) &
Left$(strTmp, 4)
If VerQueryValue(VBA.VarPtr(byteVerData(0)), strNLSKey,
lTmp, lBufLen) <> 0 Then
fGotNLSKey = True
Exit For
End If
Next
If Not fGotNLSKey Then
strNLSKey = "\StringFileInfo\040904E4"
If VerQueryValue(VBA.VarPtr(byteVerData(0)), strNLSKey,
lTmp, lBufLen) <> 0 Then
fGotNLSKey = True
End If
End If
End If
End If
GNLSKCleanup:
If fGotNLSKey Then
GetNLSKey = strNLSKey
End If
End Function
------------------------ module 3
'Eg. Get Version Details of C:\Windows\System\Comctl32.ocx
'Sub Example()
' Debug.Print FileVersionNo("C:\Windows\System\comctl32.ocx")
'End Sub
'http://www.vbusers.com/code/codeget.asp?ThreadID=58&PostID=1&NumReplies=1
'--------------GET VERSION INFO API-----------------------
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length 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 Function GetFileVersionInfoSize Lib "Version.dll" _
Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String,
lpdwHandle _
As Long) As Long
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 Type VS_FIXEDFILEINFO
Signature As Long
StrucVersionl As Integer ' e.g. = &h0000 = 0
StrucVersionh As Integer ' e.g. = &h0042 = .42
FileVersionMSl As Integer ' e.g. = &h0003 = 3
FileVersionMSh As Integer ' e.g. = &h0075 = .75
FileVersionLSl As Integer ' e.g. = &h0000 = 0
FileVersionLSh As Integer ' e.g. = &h0031 = .31
ProductVersionMSl As Integer ' e.g. = &h0003 = 3
ProductVersionMSh As Integer ' e.g. = &h0010 = .1
ProductVersionLSl As Integer ' e.g. = &h0000 = 0
ProductVersionLSh As Integer ' e.g. = &h0031 = .31
FileFlagsMask As Long ' = &h3F for version "0.42"
FileFlags As Long ' e.g. VFF_DEBUG Or VFF_PRERELEASE
FileOS As Long ' e.g. VOS_DOS_WINDOWS16
FileType As Long ' e.g. VFT_DRIVER
FileSubtype As Long ' e.g. VFT2_DRV_KEYBOARD
FileDateMS As Long ' e.g. 0
FileDateLS As Long ' e.g. 0
End Type
'Purpose : To obtain the file version info of a DLL, OCX, EXE etc.
'Inputs : sFileName The path and name of the file to
return the version info
'Outputs : Returns the file version number of the specified file
'Author : Andrew Baker
'Date : 09/10/2000 23:39
'Notes :
'Revisions :
Function FileVersionNo(sFileName As String) As String
Dim lFileHwnd As Long, lRet As Long, lBufferLen As Long, lplpBuffer
As Long, lpuLen As Long
Dim abytBuffer() As Byte
Dim tVerInfo As VS_FIXEDFILEINFO
Dim sBlock As String
Dim sStrucVer As String
Dim lentVerInfo As Long
'Get the size File version info structure
lBufferLen = GetFileVersionInfoSize(sFileName, lFileHwnd)
If lBufferLen = 0 Then
Exit Function
End If
'Create byte array buffer, then copy memory into structure
ReDim abytBuffer(lBufferLen)
Call GetFileVersionInfo(sFileName, 0&, lBufferLen, abytBuffer(0))
Call VerQueryValue(abytBuffer(0), "\", lplpBuffer, lpuLen)
'lentVerInfo = VBA.Len(tVerInfo) 'doesn't compile Len(tVerInfo) does
so force
'with magic number
lentVerInfo = 52
Call CopyMem(tVerInfo, ByVal lplpBuffer, lentVerInfo)
'Determine structure version number (For info only)
sStrucVer = VBA.Format$(tVerInfo.StrucVersionh) & "." &
VBA.Format$(tVerInfo.StrucVersionl)
'Concatenate file version number details into a result string
FileVersionNo = VBA.Format$(tVerInfo.FileVersionMSh) & "." &
VBA.Format$(tVerInfo.FileVersionMSl, "00") & "."
If tVerInfo.FileVersionLSh > 0 Then
FileVersionNo = FileVersionNo &
VBA.Format$(tVerInfo.FileVersionLSh, "0000") & "." &
VBA.Format$(tVerInfo.FileVersionLSl, "00")
Else
FileVersionNo = FileVersionNo &
VBA.Format$(tVerInfo.FileVersionLSl, "0000")
End If
End Function
Rocky Smolin - Beach Access Software wrote:
>Dear List:
>
>Does anyone have any idea why my mde might be failing on one machine on
>a network but not the others?
>
>MTIA
>
>Rocky
>
>
>-------- Original Message --------
>Subject: Re: Incompatibility?
>Date: Mon, 03 Apr 2006 14:06:28 +0530
>From: R Ramamurthy <rram22 at dataone.in>
>To: Rocky Smolin - Beach Access Software <bchacc at san.rr.com>
>References: <037001c655ff$4f2cdf00$6401a8c0 at ramamurty>
><442F5442.6010202 at san.rr.com>
>
>
>
>
> >>I never heard of an incompatibility with AutoCAD but I suppose it's
>possible. Do any other access mdbs have this problem on this machine?
>## The Access program itself opens in that computer but only PPM does
>not. There are no other *.mdb files to try out. And all other computers
>in the LAN do not have this problem.
>
>## The failure message that appears (under the PPM blue strip in the
>warning window) reads as:
>
>"The expression On Open you entered as the event property setting
>produced the following erors: Licence information for the component not
>found. You do not have an appropriate licence to use the functionality
>in the design environment.
>* The expression may not result in the name of a macro, the name of a
>user-defined function, or [ Event procedure ]
>* There may have been an error evaluating the function, event, or macro"
>
>## Rocky, please note the words
>'On Open', both with capital O's
>'design environment'
>Do these provide a clue?
>
>Does the PPM program generate such a warning?
>
>Ram
>
>
>
--
Marty Connelly
Victoria, B.C.
Canada