Alt FixAllDataAccessPages () 
 
  'Değişmeze: FixAllDataAccessPages 
  'Amaç: hepsi için geçerli veritabanında veri erişim sayfaları üzerinden gider: 
  Onların bağlantı dizeleri doğru ve emin olun * 
  '* Eğer sayfaya veritabanı konteyner gelen bağlantı güncelleştirme gerekli. 
 
      Dim CurrentPath geçerli veritabanına String 'Yol gibi 
      Dim FullPath String 'Yol ve geçerli Veritabanı Adı gibi 
      Dim DPName uzatma dahil Sayfa Dizesi 'adı olarak 
      Dim dbname mevcut veritabanı dizgi 'adı olarak 
      Dim Pgs String 'Array () olarak sayfaların listesini tutun 
      Dim FullNames String 'Array () gibi sayfanın tam adı tutun 
      Dim İsimler Dizesi 'Array () olarak Sayfa Adı tutun 
      Dim NUMPAGES Tamsayı olarak 
      Dim i tamsayı 'Basit Sayaç olarak 
      Dim WasFixed 'Boole gibi 
      Dim NumErrors Tamsayı 'Sayı hata olarak karşılaştı 
      Dim NumDBCUnfixed çözülmüş DBC link sayısına Tamsayı 'olarak ayarlayın 
 
      = "Tespit Sayfa Bağlantılar strStatusMsg" İnşaat 
 
      İnşaat strFixErrPrefix = "There were" 
      İnşaat strFixErrSuffix = "hata veri erişim sayfası bağlantıları tespit." & _ 
          "Bazı sayfaları çalışmaz Mayıs beklendiği gibi." 
      İnşaat strFixErrTitle = "Can't Fix Sayfalar!" 
 
      İnşaat strMDEMsgPrefix = "Bu dosya, bir MDE ve içerir" 
      Veri erişim sayfalarını da sabit edilememiştir için İnşaat strMDEMsgSuffix = "link." & _ 
          "Sayfa kaynakları kontrol edildi." 
      İnşaat strMDEMsgTitle = "Can't Fix DBC Linkler!" 
 
      'Eğer veritabanı okumak, sadece, o zaman düzeltmek durumunda kontrol edin 
      'Bir şey, şimdi çıkın. 
      Eğer (GetAttr (Application.CurrentProject.FullName) Ve vbReadOnly) Sonra Çıkış Alt 
 
      FullPath = CurrentDb.Name 
 
      Dbname = Mid (FullPath, InStrRev (FullPath, "\",,) vbBinaryCompare + 1) 
 
      CurrentPath = Left $ (FullPath, InStrRev (FullPath, "\",,) vbBinaryCompare - 1) 
 
      'Veri Erişim Sayfaları sayısı alın 
      NUMPAGES = CurrentProject.AllDataAccessPages.Count 
 
      'Ayarlayın dizi sayfa adlarını tutar 
      ReDim Preserve FullNames (NUMPAGES - 1) 
      ReDim Preserve İsimler (NUMPAGES - 1) 
 
      'Ve yolları ile (Adı) tüm Sayfa İsimler ve FullNames alın 
      I = 0 için NUMPAGES için - 1 
          FullNames (i) = CurrentProject.AllDataAccessPages (i). FullName 
          İsimler (i) = CurrentProject.AllDataAccessPages (i). Adı 
      Ardından 
 
      Application.Echo Yanlış, strStatusMsg 
 
      NumErrors = 0 
      NumDBCUnfixed = 0 
 
      I = 0 için NUMPAGES için - 1 
          Dizinin her sayfasından 'Adım 
          'Yolu kaldırma (eğer uzantısı koruyarak varsa) 
 
          DPName = Right (FullNames (i), Len (FullNames (i)) - InStrRev (FullNames (i) _ 
                              "\",,)) VbBinaryCompare 
          WasFixed = FixPageConnection (CurrentPath, FullNames (i) DPName, dbname, _ 
                              İsimler (i) NumDBCUnfixed) 
          Eğer () Sonra WasFixed 
                  NumErrors = NumErrors + 1 
          End If 
      Sonraki 
 
      NumErrors <> 0 Then If 
              MsgBox strFixErrPrefix & NumErrors & strFixErrSuffix, _ 
                          , strFixErrTitle vbCritical 
      End If 
 
      'Eğer mümkün olmayan bazı DBC bağlantıları düzeltmek için, bizim kötü bağlantılar bir MDE ettiğiniz anlamına gelir 
      Eğer NumDBCUnfixed <> 0 Then 
              MsgBox strMDEMsgPrefix & NumDBCUnfixed & strMDEMsgSuffix, _ 
                          , strMDEMsgTitle vbCritical 
      End If 
 
      Application.Echo Doğru 
 
  End Sub

Kamu Alt FixAllDataAccessPages () 
 
      Dim i tamsayı olarak 
      Dim DPName Dizesi olarak 
      Dim FullPath Dizesi olarak 
      Dim dbname Dizesi olarak 
      Dim CurrentPath Dizesi olarak 
      Dim FullNames Dize () gibi 
      Dim NUMPAGES Tamsayı olarak 
      Dim NumDBCUnfixed Tamsayı olarak 
      Dim Pgs Dize () gibi 
      Dim WasFixed Boole gibi 
      Dim İsimler Dize () gibi 
      Dim NumErrors Tamsayı olarak 
 
      Dize = "vardı olarak İnşaat strFixErrPrefix" 
      Veri erişim sayfalarını da sabit edilememiştir için Dize = "link olarak İnşaat strMDEMsgSuffix." & _ 
                       "Sayfa kaynakları kontrol edildi." 
      Dize = "Can't Fix Sayfalar olarak İnşaat strFixErrTitle!" 
      Dize = "Tespit Sayfa Bağlantılar olarak İnşaat strStatusMsg" 
      Dize = "Bu dosya, bir MDE ve içerir olarak İnşaat strMDEMsgPrefix" 
      Dize = "hata veri erişim sayfası bağlantıları tespit olarak İnşaat strFixErrSuffix." & _ 
                       "Bazı sayfaları çalışmaz Mayıs beklendiği gibi." 
      Dize = "Can't Fix DBC Linkler olarak İnşaat strMDEMsgTitle!" 
 
      Eğer GetAttr (CurrentProject.FullName) Ve 1 Sonra 
 
          Çıkış Alt 
 
      End If 
 
      FullPath = CurrentDb.Name 
      Dbname = Mid (FullPath, InStrRev (FullPath, "\") + 1) 
      CurrentPath = Left $ (FullPath, InStrRev (FullPath, "\") - 1) 
      NUMPAGES = CurrentProject.AllDataAccessPages.Count 
      Redim Koruma FullNames (NUMPAGES - 1) 
      Redim Koruma İsimler (NUMPAGES - 1) 
 
      I = 0 için NUMPAGES için - 1 
 
          FullNames (i) = CurrentProject.AllDataAccessPages (i). FullName 
          İsimler (i) = CurrentProject.AllDataAccessPages (i). Adı 
 
      Ardından 
 
      Echo 0, strStatusMsg 
      NumErrors = 0 
      NumDBCUnfixed = 0 
 
      I = 0 için NUMPAGES için - 1 
 
          DPName = Right (FullNames (i), Len (FullNames (i)) - InStrRev (FullNames (i), "\")) 
          WasFixed = FixPageConnection (CurrentPath, FullNames (i) DPName, dbname, _ 
                           İsimler (i) NumDBCUnfixed) 
 
          Eğer WasFixed 
 
              NumErrors = NumErrors + 1 
 
          End If 
 
      Ardından 
 
      NumErrors <> 0 Then If 
 
          MsgBox strFixErrPrefix & NumErrors & strFixErrSuffix, vbCritical, strFixErrTitle 
 
      End If 
 
      Eğer NumDBCUnfixed <> 0 Then 
 
          MsgBox strMDEMsgPrefix & NumDBCUnfixed & strMDEMsgSuffix, vbCritical strMDEMsgTitle 
 
      End If 
 
   Echo -1, vbNullString 
 
  End Sub

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          ' Veri Tabanının Yolunu Gösterin
    Dim FullPath As String             ' Şimdiki veritabanının Yolu ve Adı 
    Dim DPName As String               ' Genişleme içeren sayfanın adı
    Dim DBName As String               ' Şimdiki veri tabanının adı
    Dim Pgs() As String                ' Sayfa listesini tutan dizi
    Dim FullNames() As String          ' Sayfanın tam adını tutan dizi
    Dim Names() As String              ' Sayfanın adını tutan dizi
    Dim NumPages As Integer
    Dim i As Integer                   ' Basit sayaç
    Dim WasFixed As Boolean
    Dim NumErrors As Integer           ' Karşılaşılan hata sayısı 
    Dim NumDBCUnfixed As Integer       ' Tamir edilmemiş DBC linklerinin sayısını ayarı
 
    Const strStatusMsg = "Sayfa bağlantıları tamir ediliyor"
 
    Const strFixErrPrefix = "Vardı  "
    Const strFixErrSuffix = " Veri erişim sayfa bağlantılarının tamir hataları. " & _
        "Bazı sayfalar beklendiği gibi çalışmayabilir."
    Const strFixErrTitle = "Sayfalar tamir edilemiyor!"
 
    Const strMDEMsgPrefix = "Bu dosya bir MDE ve içerir .."
    Const strMDEMsgSuffix = "Tamir edilemeyen data erişim sayfalarına olan linkler. " & _
        " Sayfa kaynakları kontrol edildi."
    Const strMDEMsgTitle = "DBC linkleri tamir edilemiyor!"
 
    ' 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 = "Vardı .."
    Const strMDEMsgSuffix As String = " Veri erişim sayfa bağlantılarının tamir hataları.  " & _
                     "Sayfa kaynakları kontrol edildi."
    Const strFixErrTitle As String = "Sayfalar tamir edilemiyor!"
    Const strStatusMsg As String = "Sayfa bağlantıları tamir ediliyor"
    Const strMDEMsgPrefix As String = "Bu dosya bir MDE ve içerir .."
    Const strFixErrSuffix As String = " Veri erişim sayfa bağlantılarının tamir hataları. " & _
                     "Bazı sayfalar beklendiği gibi çalışmayabilir."
    Const strMDEMsgTitle As String = "DBC linkleri tamir edilemiyor!"
 
    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