Access 2000 vs. 2002 Forms question 1

[MrDeveloper]

Hi,
I have read that loading an Access 2002 application from Access 2000 is a possible cause of corruption and therefore in a shared-user environment (where multiple versions of Access exist) it is best to create the application at the lowest version level (e.g. build a 2000 app so both 2000 and 2002 users can run it).

Question is, is this issue at a forms level? I.e. If I create a new Access 2000 database/app but IMPORT the table and form objects from a 2002 application, would that remove the issue of potential problems or does each individual form/table need to be re-built in 2000?

Thanks in advance,
MrD

 

[CautionMP]

My organization went through this 4 years ago with the conversion from Office 97 to Office 2k and we are getting ready to for conversion to Office '02. We found that the corruption problem had two roots:
1) Differences in the JET DB engine from machine to machine.
2) Workgroup security file issues.

With the JET DB engine we found that developing with the lowest common denominatior (i.e. JET 4/DAO) we eliminated most of the corruption problems (except Workgroup security file problems, see below).

All of our databases are governed by a Workgroup security file that was leftover form Access 2.0. We found that as our LAN admin was deploying new machines that they contained the default reference to the System.mdw file. This in conjunction with the disparity in JET engines (and slow networks) was corrupting databases about twice a day.

Once we figured the both of these out we developed a autoexec macro that resides in each front end database that checks the version of the JET DB engine that exists on the client machine and updates if necesary, then checks for/changes the connection to the workgroup mdw file.

After taking these steps (and compacting the back-end database once a month) we have eliminated the corruption problems that we were having daily.

Hope this helps.
CMP

 

[MrDeveloper]

CautionMP:
That was a big help to confirm those issues actually. I am going through an update of the Jet DB engines as well but it is useful to hear this has helped in other situations. May I ask what the contents were of the autoexec macro? That would be most helpful.

The workgroup file was developed in 2000 so hopefully that won't be causing any problems.

I didn't mention the fact that we are experiencing corruption every few days so I am hoping the Jet changes together with an OpLocks server change will assist here.

I am still dubious about copying in 2002 forms into a 2000 database. Any other thoughts from people on this one?

Thanks,
MrD

 

[CautionMP]

Here are the two code snipits that will change the workgroup association. The first is the function to change the setting, the second is the class module that will give you complete access to the registry.
NOTE: We originally used the return value from the function to close the database if the update was done, we stopped doing this because of 'negative' comments from the staff and figured using the wrong mdw file for one session shouldn't cause too many problems.

Standard Module Call UpdateSystemDB in the AutoExec macro.

Public Function UpdateSystemDB(SystemDatabase As String, _
     Optional csvUserBypassList As String) As Boolean
'csvUserBypassList in the form "user1,user2,user3" _
will keep this routine from changing the workgroup file _
on the developers/admins machine.
Dim i As Integer
Dim strBypassList() As String, strLANID As String
'Set default value
UpdateSystemDB = False
'Check for bypass list, if present compare to LAN ID
If csvUserBypassList <> "" Then
    strBypassList = Split(csvUserBypassList, ",")
    'Capture LAN ID
    strLANID = Environ$("USERNAME")
    For i = 0 To UBound(strBypassList)
        If strLANID = strBypassList(i) Then
            Exit Function
        End If
    Next i
End If
'No Bypass list or match in bypass list so check/update registry
Dim objRegistry As New RegOp
With objRegistry
    .Root = HKEY_LOCAL_MACHINE
    .Key = "SOFTWARE\Microsoft\Office\9.0\Access\Jet\4.0\Engines"
    If .Value("SystemDB") <> SystemDatabase Then
        .Value("SystemDB") = SystemDatabase
        UpdateSystemDB = True
    End If
End With
Set objRegistry = Nothing
End Function

Class Module This supports the fuction above.

Option Compare Database
Option Explicit

'* VBA Hacker
'* The Registry Made Easy
'* A Classy Way to Bypass the Awkward Registry API
'* By Romke Soldaat
'* Dutchman Romke Soldaat was hired by Microsoft in 1988 to co-found the _
Microsoft International Product Group in Dublin, Ireland. That same year he _
started working with the prototypes of WinWord, writing his first macros _
long before the rest of the world. In 1992 he left Microsoft, and created a _
number of successful add-ons for Office. Living in Italy, he divides his _
time between writing articles for this magazine, enjoying the Mediterranean _
climate, and steering his Land Rover through the world's most deserted areas. _
Romke can be contacted at mailto:romke@soldaat.com.


 DefStr S
DefLng H-I, L, N
DefVar V
DefBool B
 Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type
  Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type
' RegCreateKeyEx creates the specified key. If the key
' already exists, the function opens it. The phkResult
' parameter receives the key handle.
Private Declare Function RegCreateKeyEx _
   Lib "advapi32.dll" Alias "RegCreateKeyExA" ( _
   ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal Reserved As Long, ByVal lpClass As String, _
   ByVal dwOptions As Long, ByVal samDesired As Long, _
  lpSecurityAttributes As SECURITY_ATTRIBUTES, _
  phkResult As Long, lpdwDisposition As Long) As Long
  'RegCloseKey releases a handle to the specified key.
  '(Key handles should not be left open any longer than
  'necessary.)
Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
   ByVal hCurKey As Long) As Long
  ' RegQueryInfoKey retrieves information about the specified
  'key, such as the number of subkeys and values, the length
  'of the longest value and key name, and the size of the
  'longest data component among the key's values.
Private Declare Function RegQueryInfoKey _
   Lib "advapi32.dll" Alias "RegQueryInfoKeyA" ( _
   ByVal hCurKey As Long, ByVal lpClass As String, _
  lpcbClass As Long, ByVal lpReserved As Long, _
  lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, _
  lpcbMaxClassLen As Long, lpcValues As Long, _
  lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, _
  lpcbSecurityDescriptor As Long, _
  lpftLastWriteTime As Long) As Long
  'RegEnumKeyEx enumerates subkeys of the specified open
  'key. Retrieves the name (and its length) of each subkey.
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" _
   Alias "RegEnumKeyExA" (ByVal hCurKey As Long, _
   ByVal dwIndex As Long, ByVal lpName As String, _
  lpcbName As Long, ByVal lpReserved As Long, _
   ByVal lpClass As String, lpcbClass As Long, _
  lpftLastWriteTime As Long) As Long
  'RegEnumValue enumerates the values for the specified open
  'key. Retrieves the name (and its length) of each value,
 'and the type, content and size of the data.
Private Declare Function RegEnumValue Lib "advapi32.dll" _
   Alias "RegEnumValueA" (ByVal hCurKey As Long, _
   ByVal dwIndex As Long, ByVal lpValueName As String, _
  lpcbValueName As Long, ByVal lpReserved As Long, _
  lpType As Long, lpData As Any, lpcbData As Long) As Long
  'RegQueryValueEx retrieves the type, content and data for
  ' a specified value name. Note that if you declare the
  ' lpData parameter as String, you must pass it By Value.
Private Declare Function RegQueryValueEx _
   Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
   ByVal hCurKey As Long, ByVal lpValueName As String, _
   ByVal lpReserved As Long, lpType As Long, _
  lpData As Any, lpcbData As Long) As Long
  'RegSetValueEx sets the data and type of a specified
  ' value under a key.
Private Declare Function RegSetValueEx Lib "advapi32.dll" _
   Alias "RegSetValueExA" (ByVal hCurKey As Long, ByVal _
  lpValueName As String, ByVal Reserved As Long, _
   ByVal dwType As Long, lpData As Any, _
   ByVal cbData As Long) As Long
  'RegDeleteValue removes a named value from specified key.
Private Declare Function RegDeleteValue _
   Lib "advapi32.dll" Alias "RegDeleteValueA" ( _
   ByVal hCurKey As Long, ByVal lpValueName As String) _
   As Long
  'RegDeleteKey deletes a subkey. Under Win 95/98, also
  'deletes all subkeys and values. Under Windows NT/2000,
  'the subkey to be deleted must not have subkeys. The class
  'attempts to use SHDeleteKey (see below) before using
  'RegDeleteKey.
Private Declare Function RegDeleteKey Lib "advapi32.dll" _
   Alias "RegDeleteKeyA" (ByVal hKey As Long, _
   ByVal lpSubKey As String) As Long
  'SHDeleteKey deletes a subkey and all its descendants.
  'Under Windows NT 4.0, Internet Explorer 4.0 or later
  'is required.
Private Declare Function SHDeleteKey Lib "Shlwapi" _
   Alias "SHDeleteKeyA" (ByVal hKey As Long, _
   ByVal lpSubKey As String) As Long
 Private Declare Function LoadLibrary Lib "Kernel32" _
   Alias "LoadLibraryA" (ByVal lpLibFileName As String) _
   As Long
  Private Declare Function FreeLibrary Lib "Kernel32" ( _
   ByVal hLibModule As Long) As Long
  Private Declare Function ExpandEnvStrings Lib "Kernel32" _
   Alias "ExpandEnvironmentStringsA" ( _
   ByVal lpSrc As String, ByVal lpDst As String, _
   ByVal nSize As Long) As Long
  Private Declare Function GetVersionEx Lib "Kernel32" _
   Alias "GetVersionExA" ( _
  lpVersionInformation As OSVERSIONINFO) As Long
  Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_DWORD = 4
Private Const REG_DWORD_LITTLE_ENDIAN = REG_DWORD
Private Const REG_MULTI_SZ = 7
  
' The following values are only relevant under WinNT/2K,
' and are ignored by Win9x.
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const STANDARD_RIGHTS_WRITE = &H20000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const SYNCHRONIZE = &H100000
  ' Access right to query and enumerate values.
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
  KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or _
  KEY_NOTIFY) And (Not SYNCHRONIZE))
'Access right to create values and keys.
Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
  KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And _
   (Not SYNCHRONIZE))
'Access right to create/delete values and keys.
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
  KEY_QUERY_VALUE Or KEY_SET_VALUE Or _
  KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
  KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
  Private lRequiredAccess
  Private lPreviousAccess
 'Return values for all registry functions.
Private Const ERROR_SUCCESS = 0
  'Property variables.
Private lRoot 'default is HKEY_LOCAL_MACHINE
Private lOptions
Private strKeyName
Private strValueName
Private vData
  'Variables set in GetKeyHandle.
Private hCurKey
Private nSubKeys
Private nValues
Private lMaxSubKeyLen
Private lMaxValueNameLen
Private lMaxValueLen
  Private bIsWinNT
  Public Enum RegOptions ' variable: lOptions
  StoreNumbersAsStrings = 1
  ReturnMultiStringsAsArrays = 2
  ExpandEnvironmentStrings = 4
  ShowErrorMessages = 8
End Enum
   Public Enum RegRoot ' variable: lRoot
  HKEY_CLASSES_ROOT = &H80000000
  HKEY_CURRENT_USER = &H80000001   ' default
  HKEY_LOCAL_MACHINE = &H80000002
End Enum
  'Message constants.
Private Const ERROR_NO_KEY As String = _
  "No Key name specified!"
Private Const ERROR_NO_HANDLE = _
  "Could not open Registry Key!"
Private Const ERR_MSG_NO_OVERWRITE As String = _
  "Existing value has unsupported data type " & _
  "and will not be overwritten"
Private Const RETURN_UNSUPPORTED As String = _
  "(unsupported data format)"
  Private ValueList As Object
  Property Let Root(lProp As RegRoot)
  ' Don't accept an invalid Root value.
  Select Case lProp
    Case HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, _
          HKEY_LOCAL_MACHINE
       ' All is well.
    Case Else
      lRoot = HKEY_CURRENT_USER
  End Select
  If lProp <> lRoot Then
    lRoot = lProp
     If Len(strKeyName) Then
      GetKeyHandle lRoot, strKeyName
     End If
  End If
  lRoot = lProp
End Property
  Property Let Key(strProp)
  ' Don't accept an empty key name.
  If Len(strProp) = 0 Then Exit Property
  If Len(strKeyName) = 0 Then ' first time
    strKeyName = strProp
  ElseIf StrComp(strProp, strKeyName, _
                 vbTextCompare) <> 0 Then
    strKeyName = strProp
    GetKeyHandle lRoot, strKeyName
  Else
  End If
End Property
  Property Let Options(lProp As RegOptions)
  ' Don't accept an invalid Options value.
  Select Case lProp
    Case 0 To 15: lOptions = lProp
    Case Else:
   End Select
End Property
   Property Let Value(Optional ValueName As String, vValue)
  If IsEmpty(vValue) Then
     Exit Property
   Else
    vData = vValue
   End If
  If bIsWinNT Then lRequiredAccess = KEY_WRITE Or KEY_READ
  If PropertiesOK Then
     ' First see if this is an existing value, and,
     ' if so, what data type we have here.
     Dim strBuffer, lBuffer, lType
     If RegQueryValueEx(hCurKey, ValueName, 0, lType, _
        ByVal strBuffer, lBuffer) = ERROR_SUCCESS Then
       ' Make sure our new value is the same data type.
       Select Case lType
         Case REG_SZ, REG_EXPAND_SZ ' existing string
          vData = CStr(vData)
         Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN
           ' existing long
          vData = CLng(vData)
         Case REG_MULTI_SZ ' existing array
          vData = CVar(vData)
         Case Else
          ShowErrMsg ERR_MSG_NO_OVERWRITE
           Exit Property
       End Select
     End If
     If (lOptions And StoreNumbersAsStrings) Then
       If IsNumeric(vData) Then vData = CStr(vData)
     End If
     ' If nameless "(default)" value:
     If Len(ValueName) = 0 Then vData = CStr(vData)
     ' Look at the data type of vData, and store it
     ' in the appropriate registry format.
     If VarType(vData) And vbArray Then   ' 8192
       Dim sTemp As String
       ' REG_MULTI_SZ values must end with 2 null characters.
      sTemp = Join(vData, vbNullChar) & String$(2, 0)
       Call RegSetValueEx(hCurKey, ValueName, 0, _
        REG_MULTI_SZ, ByVal sTemp, Len(sTemp))
     Else
       Select Case VarType(vData)
         Case vbInteger, vbLong
           Call RegSetValueEx(hCurKey, ValueName, 0, _
            REG_DWORD, CLng(vData), 4)
         Case vbString
           If ContainsEnvString(CStr(vData)) Then
             Call RegSetValueEx(hCurKey, ValueName, 0, _
              REG_EXPAND_SZ, ByVal CStr(vData), _
              Len(vData) + 1)
           Else
             Call RegSetValueEx(hCurKey, ValueName, 0, _
              REG_SZ, ByVal CStr(vData), Len(vData) + 1)
           End If
         Case Else ' Store any other data type as string.
           Call RegSetValueEx(hCurKey, ValueName, 0, _
            REG_SZ, ByVal CStr(vData), Len(vData) + 1)
       End Select
     End If
     ' Update Value Count.
     Call RegQueryInfoKey(hCurKey, vbNullString, 0, 0, 0, _
       0, 0, nValues, 0, 0, 0, 0)
     ' Clear the values database.
    ValueList.RemoveAll
  End If
End Property
 Property Get Value(Optional ValueName As String) As Variant
  With ValueList
     If .Count = 0 Then FillDataList
     If .Exists(ValueName) Then Value = .Item(ValueName)
  End With
End Property
  Property Get AllValues() As Variant
  If bIsWinNT Then lRequiredAccess = KEY_READ
  If PropertiesOK Then
     If nValues = 0 Then Exit Property
     With ValueList
       If .Count = 0 Then FillDataList
       If .Count Then
         Dim i, vKeys, vItems
        vKeys = .Keys
        vItems = .items
         ReDim vTemp(.Count - 1, 1)
         For i = 0 To .Count - 1
          vTemp(i, 0) = vKeys(i)
          vTemp(i, 1) = vItems(i)
         Next
        AllValues = vTemp
       End If
     End With
  End If
End Property
  Property Get AllKeys() As Variant
  If bIsWinNT Then lRequiredAccess = KEY_READ
  If PropertiesOK Then
     If nSubKeys = 0 Then Exit Property
     Dim i: ReDim vTemp(nSubKeys - 1)
     For i = 0 To nSubKeys - 1
      strKeyName = String$(lMaxSubKeyLen + 1, 0)
       If RegEnumKeyEx(hCurKey, i, strKeyName, _
         lMaxSubKeyLen + 1, 0, vbNullString, 0, 0) = _
         ERROR_SUCCESS Then
        vTemp(i) = TrimNull(strKeyName)
       End If
     Next
    AllKeys = vTemp
  End If
End Property
 Function DeleteValue(Optional ValueName As String) _
   As Boolean
   If bIsWinNT Then lRequiredAccess = KEY_ALL_ACCESS
  If PropertiesOK Then
    DeleteValue = (RegDeleteValue(hCurKey, ValueName) = _
      ERROR_SUCCESS)
     If DeleteValue Then
       Call RegQueryInfoKey(hCurKey, vbNullString, 0, 0, _
        0, 0, 0, nValues, 0, 0, 0, 0)
      ValueList.RemoveAll
     End If
  End If
End Function
  Function DeleteKey() As Boolean
  If Len(strKeyName) = 0 Then
    ShowErrMsg ERROR_NO_KEY
     Exit Function
  End If
  Dim n, strLastKey
  n = InStrRev(strKeyName, "\")
  If n > 0 And n < Len(strKeyName) Then
    strLastKey = Mid$(strKeyName, n + 1)
    strKeyName = Left$(strKeyName, n - 1)
     If bIsWinNT Then lRequiredAccess = KEY_ALL_ACCESS
     Call GetKeyHandle(lRoot, strKeyName)
     If hCurKey = 0 Then Exit Function
     If ShlwapiInstalled Then
       ' This should always work.
      DeleteKey = (SHDeleteKey(hCurKey, strLastKey) = _
        ERROR_SUCCESS)
     Else
       ' This will only work under Win95/98.
      DeleteKey = (RegDeleteKey(hCurKey, strLastKey) = _
        ERROR_SUCCESS)
     End If
     If DeleteKey Then
       Call RegQueryInfoKey(hCurKey, vbNullString, 0, 0, _
        nSubKeys, 0, 0, 0, 0, 0, 0, 0)
      ValueList.RemoveAll
     End If
  End If
End Function
  Property Get ValueCount() As Long
  If PropertiesOK Then ValueCount = nValues
End Property
 Property Get KeyCount() As Long
  If PropertiesOK Then KeyCount = nSubKeys
End Property
  
Private Function PropertiesOK() As Boolean
  If Len(strKeyName) = 0 Then
    ShowErrMsg ERROR_NO_KEY
     Exit Function
  End If
  If lPreviousAccess Then
     If lRequiredAccess <> lPreviousAccess Then _
      CloseCurrentKey
  End If
  If hCurKey = 0 Then Call GetKeyHandle(lRoot, strKeyName)
  If hCurKey = 0 Then
    ShowErrMsg ERROR_NO_HANDLE
     Exit Function
  End If
  PropertiesOK = True
End Function
  Private Sub Class_Initialize()
  lRoot = HKEY_CURRENT_USER
  bIsWinNT = IsWinNT
  If bIsWinNT Then lRequiredAccess = KEY_READ
  On Error Resume Next
  Set ValueList = CreateObject("Scripting.Dictionary")
  If IsObject(ValueList) Then
    ValueList.CompareMode = vbTextCompare
  Else
     End
  End If
End Sub
 Private Sub Class_Terminate()
  CloseCurrentKey
  Set ValueList = Nothing
End Sub
 Private Sub CloseCurrentKey()
  If hCurKey Then
     Call RegCloseKey(hCurKey)
    hCurKey = 0
  End If
End Sub
 Private Sub GetKeyHandle(lKey, strKey)
  CloseCurrentKey
  If lKey = 0 Then lKey = HKEY_CURRENT_USER
  Dim SA As SECURITY_ATTRIBUTES
  Call RegCreateKeyEx(lKey, strKey, 0, vbNull, 0, _
    lRequiredAccess, SA, hCurKey, 0)
   If hCurKey Then
     Call RegQueryInfoKey(hCurKey, vbNullString, 0, 0, _
      nSubKeys, lMaxSubKeyLen, 0, nValues, _
      lMaxValueNameLen, lMaxValueLen, 0, 0)
    ValueList.RemoveAll
    lPreviousAccess = lRequiredAccess
   End If
End Sub
 Private Function TrimNull(ByVal strIn) As String
  TrimNull = Left$(strIn, InStr(strIn, vbNullChar) - 1)
End Function
  Private Function TrimDoubleNull(ByVal strIn) As String
  If Len(strIn) Then _
    TrimDoubleNull = _
      Left$(strIn, InStr(strIn, String$(2, 0)) - 1)
End Function
  Private Function ExpandString(strIn) As String
  Dim nChars, strBuff, nBuffSize
  nBuffSize = 1024
  strBuff = String$(nBuffSize, 0)
  nChars = ExpandEnvStrings(strIn, strBuff, nBuffSize)
  If nChars Then ExpandString = Left$(strBuff, nChars - 1)
End Function
 Private Function ShlwapiInstalled() As Boolean
  Dim hLib As Long
  hLib = LoadLibrary("Shlwapi")
  If hLib Then
    ShlwapiInstalled = True
    FreeLibrary hLib
  End If
End Function
 Private Function ContainsEnvString(ByVal strTest) _
   As Boolean
   Const PCT As String = "%"
  ' See if there is a percent sign.
  Dim n As Long:
n = InStr(strTest, PCT)
  If n = 0 Then Exit Function
  ' See if there is a second percent sign.
  If n = InStrRev(strTest, PCT) Then Exit Function
  ' Now we have a potential environment string.
  Dim Env As String, EnvSplit() As String
  Dim i As Long
  For i = 1 To 100
    Env = Environ(i)
     If Len(Env) Then
      EnvSplit = Split(Env, "=")
       If InStr(1, strTest, PCT & EnvSplit(0) & PCT, _
               vbTextCompare) Then
        ContainsEnvString = True
         Exit For
       End If
     Else
       Exit For
     End If
  Next
End Function
 Private Sub ShowErrMsg(strMsg)
  If (lOptions And ShowErrorMessages) Then
    MsgBox strMsg, vbExclamation, "Registry Error"
  Else
     Debug.Print strMsg
  End If
End Sub
  Private Function IsWinNT()
  ' Returns True if the OS is Windows NT/2000.
  Const VER_PLATFORM_WIN32_NT As Long = 2
  Dim osvi As OSVERSIONINFO
  osvi.dwOSVersionInfoSize = Len(osvi)
  GetVersionEx osvi
  IsWinNT = (osvi.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
  Private Sub FillDataList(Optional Key As String)
  If Len(Key) Then strKeyName = Key
  If Len(strKeyName) = 0 Then _
    ShowErrMsg ERROR_NO_KEY: Exit Sub
  If bIsWinNT Then lRequiredAccess = KEY_READ
  If PropertiesOK Then
     If nValues = 0 Then Exit Sub
    ValueList.RemoveAll
     Dim i, lValuename, lType, lBuffer, strValue, strBuffer
     For i = 0 To nValues - 1
      lValuename = lMaxValueNameLen + 1
      strValue = String$(lValuename, 0)
      lBuffer = lMaxValueLen + 1
      strBuffer = String$(lBuffer, 0)
       If RegEnumValue(hCurKey, i, strValue, lValuename, _
         0, lType, ByVal strBuffer, lBuffer) = _
         ERROR_SUCCESS Then
        strValue = TrimNull(strValue)
         Select Case lType
           Case REG_SZ
            ValueList(strValue) = TrimNull(strBuffer)
           Case REG_EXPAND_SZ
             If (lOptions And ExpandEnvironmentStrings) Then
              ValueList(strValue) = _
                ExpandString(TrimNull(strBuffer))
             Else
              ValueList(strValue) = TrimNull(strBuffer)
             End If
           Case REG_MULTI_SZ
             If (lOptions And _
                ReturnMultiStringsAsArrays) Then
              ValueList(strValue) = Split( _
                TrimDoubleNull(strBuffer), vbNullChar)
             Else
              ValueList(strValue) = _
                TrimDoubleNull(strBuffer)
             End If
           Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN
             Dim nBuffer
             If RegEnumValue(hCurKey, i, strValue, _
               Len(strValue) + 1, 0, REG_DWORD, nBuffer, _
               4) = ERROR_SUCCESS Then
              ValueList(strValue) = nBuffer
             End If
           Case Else
            ValueList(strValue) = RETURN_UNSUPPORTED
         End Select
       End If
     Next
  End If

End Sub

 

[CautionMP]

The code to keep the JET DB engine in sync was developed by one of my coworkers so I don't have a sample here (home). I will have to check on it/post later.

CMP

 

[MrDeveloper]

CMP:
Thanks again for your useful post regarding this issue and including the code. I will have a look and try and implement it.

Regarding the issue of using 2002 forms, I think I will assume the possibility of corruption is minimal and perhaps no need to re-build them in 2000 format.

Any other thoughts from anyone on whether this is the case when importing 2002 forms into 2000 would be much appreciated though.

Many thanks,
MrD.

 

[CautionMP]

You should not need to re-create the forms, it is the database engine that is causing the corruption.

Here is the last piece of code:

Public Function fCopy_JET40() As Boolean
Dim dblPID As Double
Dim strFileTest As String, strClosingMessage As String
fCopy_JET40 = True
strFileTest = Dir("C:\WINNT\System32\dao360.dll", 0)
If strFileTest <> "dao360.dll" Then
    FileCopy "S:\[i]YourSharedPathHere[/i]\dao360.dll", "C:\WINNT\System32\dao360.dll"
    dblPID = Shell("regsvr32 C:\WINNT\System32\dao360.dll")
    If strClosingMessage <> "" Then strClosingMessage = strClosingMessage & vbCrLf
    strClosingMessage = strClosingMessage & vbTab & "dao360.dll"
    fCopy_JET40 = False
End If
If fCopy_JET40 = False Then
    strClosingMessage = "It appears that this is the first time you have opened this" & _
        vbCrLf & "datbase. For this database to work correctly the following components" & _
        vbCrLf & "are being installed:" & _
        vbCrLf & strClosingMessage & _
        vbCrLf & "The database will now be closed so the components can be registered." & _
        vbCrLf & "Once Windows has registered the components you will receive a conformation" & _
        vbCrLf & "for each component listed above. After receiving all confirmation notices" & _
        vbCrLf & "you can reopen the database."
    MsgBox strClosingMessage, vbOKOnly, "Installing and Registering components"
    Application.Quit
Else
    DoCmd.OpenForm "frmMemberLC_Main", acNormal
End If
End Function

CMP