This page is split into two sections. The first shows the original source code prior to making an MDE file. The second shows our reverse engineered code from the subsequently created MDE file.
- Original source code
- Reverse engineered source code
Original Source: (taken from Northwind 2000 Sample database)
Sub FixAllDataAccessPages()
' Subroutine: FixAllDataAccessPages
' Purpose: Goes through all of the data access pages in the current database to:
' * Make sure their connection strings are correct and,
' * If necessary, update the link from the database container to the page.
Dim CurrentPath As String ' Path to the current Database
Dim FullPath As String ' Path & Name of the current Database
Dim DPName As String ' Name of Page including extension
Dim DBName As String ' Name of the current database
Dim Pgs() As String ' Array to hold the list of pages
Dim FullNames() As String ' Array to hold the FULL name of the Page
Dim Names() As String ' Array to hold the Page Name
Dim NumPages As Integer
Dim i As Integer ' Simple Counter
Dim WasFixed As Boolean
Dim NumErrors As Integer ' Number of errors encountered
Dim NumDBCUnfixed As Integer ' Set to the number of unfixed DBC links
Const strStatusMsg = "Fixing Page Connections"
Const strFixErrPrefix = "There were "
Const strFixErrSuffix = " errors fixing your data access page " & _
"connections. Some pages may not function as expected."
Const strFixErrTitle = "Cannot Fix Pages!"
Const strMDEMsgPrefix = "This file is an MDE and contains "
Const strMDEMsgSuffix = " links to data access pages which could " & _
"not be fixed. The page sources have been checked."
Const strMDEMsgTitle = "Cannot Fix DBC Links!"
' Check if the database is read only, then we won't be able to fix
' anything, so exit now.
If (GetAttr(Application.CurrentProject.FullName) And vbReadOnly) Then Exit Sub
FullPath = CurrentDb.Name
DBName = Mid(FullPath, InStrRev(FullPath, "\", , vbBinaryCompare) + 1)
CurrentPath = Left$(FullPath, InStrRev(FullPath, "\", , vbBinaryCompare) - 1)
' Get the total number of Data Access Pages
NumPages = CurrentProject.AllDataAccessPages.Count
' Set the array to hold the page names
ReDim Preserve FullNames(NumPages - 1)
ReDim Preserve Names(NumPages - 1)
' Get all the Page Names and FullNames (Name with and without paths)
For i = 0 To NumPages - 1
FullNames(i) = CurrentProject.AllDataAccessPages(i).FullName
Names(i) = CurrentProject.AllDataAccessPages(i).Name
Next i
Application.Echo False, strStatusMsg
NumErrors = 0
NumDBCUnfixed = 0
For i = 0 To NumPages - 1
' Step through each page in the Array
' Removing the path (preserving the extension if any)
DPName = Right(FullNames(i), Len(FullNames(i)) - InStrRev(FullNames(i), _
"\", , vbBinaryCompare))
WasFixed = FixPageConnection(CurrentPath, FullNames(i), DPName, DBName, _
Names(i), NumDBCUnfixed)
If Not (WasFixed) Then
NumErrors = NumErrors + 1
End If
Next
If NumErrors <> 0 Then
MsgBox strFixErrPrefix & NumErrors & strFixErrSuffix, _
vbCritical, strFixErrTitle
End If
' If we weren't able to fix some DBC links, it means we're an MDE with bad links
If NumDBCUnfixed <> 0 Then
MsgBox strMDEMsgPrefix & NumDBCUnfixed & strMDEMsgSuffix, _
vbCritical, strMDEMsgTitle
End If
Application.Echo True
End Sub
Reverse Engineered Source Code: (from a Northwind 2000 MDE database)
Public Sub FixAllDataAccessPages()
Dim i As Integer
Dim DPName As String
Dim FullPath As String
Dim DBName As String
Dim CurrentPath As String
Dim FullNames() As String
Dim NumPages As Integer
Dim NumDBCUnfixed As Integer
Dim Pgs() As String
Dim WasFixed As Boolean
Dim Names() As String
Dim NumErrors As Integer
Const strFixErrPrefix As String = "There were "
Const strMDEMsgSuffix As String = " links to data access pages which could " & _
"not be fixed. The page sources have been checked."
Const strFixErrTitle As String = "Cannot Fix Pages!"
Const strStatusMsg As String = "Fixing Page Connections"
Const strMDEMsgPrefix As String = "This file is an MDE and contains "
Const strFixErrSuffix As String = " errors fixing your data access page " & _
"connections. Some pages may not function as expected."
Const strMDEMsgTitle As String = "Cannot Fix DBC Links!"
If GetAttr(CurrentProject.FullName) And 1 Then
Exit Sub
End If
FullPath = CurrentDb.Name
DBName = Mid(FullPath, InStrRev(FullPath, "\") + 1)
CurrentPath = Left$(FullPath, InStrRev(FullPath, "\") - 1)
NumPages = CurrentProject.AllDataAccessPages.Count
Redim Preserve FullNames(NumPages - 1)
Redim Preserve Names(NumPages - 1)
For i = 0 To NumPages - 1
FullNames(i) = CurrentProject.AllDataAccessPages(i).FullName
Names(i) = CurrentProject.AllDataAccessPages(i).Name
Next i
Echo 0, strStatusMsg
NumErrors = 0
NumDBCUnfixed = 0
For i = 0 To NumPages - 1
DPName = Right(FullNames(i), Len(FullNames(i)) - InStrRev(FullNames(i), "\"))
WasFixed = FixPageConnection(CurrentPath, FullNames(i), DPName, DBName, _
Names(i), NumDBCUnfixed)
If Not WasFixed Then
NumErrors = NumErrors + 1
End If
Next i
If NumErrors <> 0 Then
MsgBox strFixErrPrefix & NumErrors & strFixErrSuffix, _
vbCritical, strFixErrTitle
End If
If NumDBCUnfixed <> 0 Then
MsgBox strMDEMsgPrefix & NumDBCUnfixed & strMDEMsgSuffix, _
vbCritical, strMDEMsgTitle
End If
Echo -1, vbNullString
End Sub
More Information
FAQs
Enquire Here
