Slower performance in Access-based or Jet database-based programs after you upgrade from Windows NT 4.0 to Windows 2000 or to Windows XP (891176)

RESOLUTION

Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements. If you are working with a split database, you can resolve this issue by relinking your existing Jet tables. To do this, create code to send a short representation of the long folder name to the Windows API. This resolution requires your backend database to have a file name that follows the 8.3 naming convention. To create this code, follow these steps in the front-end database:

1. Set a reference to Microsoft ADO Ext 2.5 (or to a later version of ADO).
2. Add the following code to a new module.

   Declare Function GetShortPathName Lib "kernel32" _
               Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
              ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
   
   Function RefreshLinks()
       On Error GoTo ErrorHandler
       
       'Define the ADOX Catalog object.
       Dim objCat As New ADOX.Catalog 
       'Define the ADOX Table object.
       Dim objTbl As ADOX.Table 
   
       'Database name of the linked table.
       Dim strFilename As String 
       'Path and database name of the linked table.
       Dim strFullName As String 
   
       Dim blnIsMapi As Boolean
       Dim blnIsImex As Boolean
       Dim blnIsTemp As Boolean
       Dim blnLongFileName As Boolean
       Dim blnFailedLink As Boolean
       Const srtImex = "IMEX"
       Const strMapi = "MAPILEVEL="
   
       'Open the catalog.
       objCat.ActiveConnection = CurrentProject.Connection
   
       'Loop through the table collection and update the linked tables.
       For Each objTbl In objCat.Tables
           'Verify that the table is a linked table.
           If objTbl.Type = "LINK" = True Then
               blnIsTemp = objTbl.Properties("Temporary Table") Or Left(objTbl.Name, 1) = "~"
               blnIsImex = (InStr(1, objTbl.Properties("Jet OLEDB:Link Provider String"), srtImex, vbTextCompare) > 0)
               blnIsMapi = (InStr(1, objTbl.Properties("Jet OLEDB:Link Provider String"), strMapi, vbTextCompare) > 0)
   
               If Not blnIsTemp And Not blnIsImex And Not blnIsMapi Then  
                   'Verify that the table is a Jet table.
                   strFullName = objTbl.Properties("Jet OLEDB:Link Datasource")
                   strFilename = Mid(strFullName, InStrRev(strFullName, "\", _
                               Len(strFullName)) + 1, Len(strFullName))
                   'Determine whether the database exists.
                   If DoesFileExist(strFullName) = True Then
                       objTbl.Properties("Jet OLEDB:Link Datasource") = GetShortName(strFullName)  
                   'Update the link by using the short path name.
                   Else
                       MsgBox "Cannot update: '" & objTbl.Name & "'" & String(2, vbCrLf) & "File not found: " & vbCrLf & strFullName
                       blnFailedLink = True
                   End If
                   If InStr(strFilename, ".") > 9 Then blnLongFileName = True
               End If
           End If
       Next
      
       If blnFailedLink = False Then
           If blnLongFileName = True Then
               MsgBox "The table links were successfully updated, but the name of the backend database file does not follow 8.3" & _
               vbCrLf & "Please rename the file, relink the tables, and then run the procedure again.", vbExclamation
           Else
               MsgBox "The links were successfully updated!!! ", vbInformation
           End If
       Else
           MsgBox "The links were not successfully updated." & vbCrLf & "Please verify you table links.", vbExclamation
       End If
   
   ExitHandler:
        Exit Function
   
   ErrorHandler:
       MsgBox Err.Description & " " & Err.Number
       Resume ExitHandler
       
   End Function
   Function GetShortName(ByVal sLongFileName As String) As String
              Dim lRetVal As Long, sShortPathName As String, iLen As Integer
              'Set up a buffer area for the API function call return.
              sShortPathName = Space(255)
              iLen = Len(sShortPathName)
       
              'Call the function.
              lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
              'Remove unwanted characters.
              GetShortName = Left(sShortPathName, lRetVal)
    End Function
   
   Function DoesFileExist(strFileSpec As String) As Boolean
       'Return True if the file that is specified in the
       'strFilespec argument exists.
       'Return False if strFileSpec is not a valid
       'file or if strFileSpec is a directory.
       Const INVALID_ARGUMENT As Long = 53
       On Error GoTo DoesfileExist_Err
       If (GetAttr(strFileSpec) And vbDirectory) <> vbDirectory Then
           DoesFileExist = CBool(Len(Dir(strFileSpec)) > 0)
       Else
           DoesFileExist = False
       End If
   DoesfileExist_End:
       Exit Function
   DoesfileExist_Err:
       DoesFileExist = False
       Resume DoesfileExist_End
   End Function
   

3. Run the RefreshLinks function. To do this, follow these steps:
   1. In Visual Basic Editor, click Immediate Window on the View menu.
   2. In the Immediate window, type RefreshLinks. Then, press ENTER.

The RefreshLinks function loops though the linked Jet tables in a database and verifies whether the link is valid. If the link is valid, this code uses the Windows API function GetShortPathName to create a short name that follows the 8.3 naming convention. For additional information, click the following article number to view the article in the Microsoft Knowledge Base: This code then updates the link by using a path that includes the new short name. If the link points to a backend database file that does not follow the 8.3 naming convention, this code generates a message to suggest that you rename the backend database file.