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.

1. Original source code
2. 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