请教如何用代码改写数据库属性

KenjiSato

ACCESS 2000中文版 高级编程有讲到，但在ADP中如何写？

KenjiSato

KenjiSato

Option Compare Database
Option Explicit

Public Const apErrDeviceNotAvlble = 68
Public Const apErrFileNotFound = 3024
Public Const apErrPathNotValid = 3044
Public Const apErrTableNotFound = 3078
Public Const apErrComDlgCancel = 32755
Public Const apErrDBCorrupted1 = 3049
Public Const apErrDBCorrupted2 = 3428

Public pstrAppPath As String
Public pstrBackEndPath As String
Public pstrBackEndName As String

Public intRepEdited As Integer

Public flgLeaveApplication As Boolean
Function ap_AppInit()
   
    Dim dbLocal As Database, dbNet As Database
    Dim dynSharedTables As Recordset, dynTestTable As Recordset
    Dim intCurrError As Integer, strCurrError As String
         
    DoEvents
    DoCmd.Echo True, "Checking Connections..."
   
    flgLeaveApplication = False
   
    Set dbLocal = CurrentDb()
     
    pstrAppPath = CurrentProject.Path
    pstrBackEndName = _
            ap_GetDatabaseProp(dbLocal, "BackEndName")
    pstrBackEndPath = _
            ap_GetDatabaseProp(dbLocal, "LastBackEndPath")

    '-- Section 2: User requested to logout, quit the application
    If ap_LogOutCheck(pstrBackEndPath) Then
        
        Beep
        
        MsgBox "Maintenance is being performed on the backend" & _
            vbCrLf & vbCrLf & _
            "All users are requested to logout at this time.", _
             vbOKOnly + vbCritical, "Logging Out for Maintenance"
        
        Application.Quit
        
        Exit Function
    End If
   
    '-- Section 3: Open the table containing the list of
    '   linked tables
    Set dynSharedTables = dbLocal.OpenRecordset _
                    ("tblSharedTables", dbOpenDynaset)
      
    On Error Resume Next
   
    dynSharedTables.MoveLast
   
    Set dynTestTable = dbLocal.OpenRecordset _
                    (dynSharedTables!TableName, _
         dbOpenDynaset)
      
    intCurrError = 3428 'Err.Number
    strCurrError = Err.Description
      
    Do Until intCurrError = 0
      
       On Error GoTo Error_ap_App_Init
      
       Select Case intCurrError
         Case apErrFileNotFound, apErrTableNotFound, _
              apErrPathNotValid, apErrDeviceNotAvlble
      
            '-- Section 4: If the Data MDB is found in the
            '              App Directory, link the files.
         
             If Dir(pstrAppPath & "\" & pstrBackEndName) = _
                            pstrBackEndName Then
                 
                ap_LinkTables dbLocal, dynSharedTables, _
                            pstrAppPath & "\" & pstrBackEndName
                           
                pstrBackEndPath = pstrAppPath
                 
             Else
            
                '-- Section 5: Allow the user to locate the BackEnd MDB
                If Not ap_LocateBackend(dbLocal, dynSharedTables, _
                       strCurrError) Then
                   flgLeaveApplication = True
                End If
            
             End If
              
         Case apErrDBCorrupted1, apErrDBCorrupted2
            
            '-- Section 6: Backend Corrupted. Compact/Repair?
            Beep
            
            If MsgBox("The Backend Database is Corrupted." & vbCrLf & _
               vbCrLf & "Would you like to log users out and " & _
               " attempt to compact/repair it?", vbYesNo + vbCritical, _
               "Corrupted Backend!") = vbYes Then
               
               DoCmd.OpenForm "ap_CompactDatabase", acForm
               
            Else
               
               flgLeaveApplication = True
            
            End If
         
       End Select
      
       '-- Section 7: Leave the application if requested
       If flgLeaveApplication Then
          Application.Quit
          Exit Function
       End If
      
       On Error Resume Next
      
       '-- Section 8: Let's try and open the first table again.
       dynSharedTables.MoveFirst
      
       Set dynTestTable = dbLocal.OpenRecor

KenjiSato

Option Compare Database
Option Explicit

Public Const apErrDeviceNotAvlble = 68
Public Const apErrFileNotFound = 3024
Public Const apErrPathNotValid = 3044
Public Const apErrTableNotFound = 3078
Public Const apErrComDlgCancel = 32755
Public Const apErrDBCorrupted1 = 3049
Public Const apErrDBCorrupted2 = 3428

Public pstrAppPath As String
Public pstrBackEndPath As String
Public pstrBackEndName As String

Public intRepEdited As Integer

Public flgLeaveApplication As Boolean
Function ap_AppInit()
   
    Dim dbLocal As Database, dbNet As Database
    Dim dynSharedTables As Recordset, dynTestTable As Recordset
    Dim intCurrError As Integer, strCurrError As String
         
    DoEvents
    DoCmd.Echo True, "Checking Connections..."
   
    flgLeaveApplication = False
   
    Set dbLocal = CurrentDb()
     
    pstrAppPath = CurrentProject.Path
    pstrBackEndName = _
            ap_GetDatabaseProp(dbLocal, "BackEndName")
    pstrBackEndPath = _
            ap_GetDatabaseProp(dbLocal, "LastBackEndPath")

    '-- Section 2: User requested to logout, quit the application
    If ap_LogOutCheck(pstrBackEndPath) Then
        
        Beep
        
        MsgBox "Maintenance is being performed on the backend" & _
            vbCrLf & vbCrLf & _
            "All users are requested to logout at this time.", _
             vbOKOnly + vbCritical, "Logging Out for Maintenance"
        
        Application.Quit
        
        Exit Function
    End If
   
    '-- Section 3: Open the table containing the list of
    '   linked tables
    Set dynSharedTables = dbLocal.OpenRecordset _
                    ("tblSharedTables", dbOpenDynaset)
      
    On Error Resume Next
   
    dynSharedTables.MoveLast
   
    Set dynTestTable = dbLocal.OpenRecordset _
                    (dynSharedTables!TableName, _
         dbOpenDynaset)
      
    intCurrError = 3428 'Err.Number
    strCurrError = Err.Description
      
    Do Until intCurrError = 0
      
       On Error GoTo Error_ap_App_Init
      
       Select Case intCurrError
         Case apErrFileNotFound, apErrTableNotFound, _
              apErrPathNotValid, apErrDeviceNotAvlble
      
            '-- Section 4: If the Data MDB is found in the
            '              App Directory, link the files.
         
             If Dir(pstrAppPath & "\" & pstrBackEndName) = _
                            pstrBackEndName Then
                 
                ap_LinkTables dbLocal, dynSharedTables, _
                            pstrAppPath & "\" & pstrBackEndName
                           
                pstrBackEndPath = pstrAppPath
                 
             Else
            
                '-- Section 5: Allow the user to locate the BackEnd MDB
                If Not ap_LocateBackend(dbLocal, dynSharedTables, _
                       strCurrError) Then
                   flgLeaveApplication = True
                End If
            
             End If
              
         Case apErrDBCorrupted1, apErrDBCorrupted2
            
            '-- Section 6: Backend Corrupted. Compact/Repair?
            Beep
            
            If MsgBox("The Backend Database is Corrupted." & vbCrLf & _
               vbCrLf & "Would you like to log users out and " & _
               " attempt to compact/repair it?", vbYesNo + vbCritical, _
               "Corrupted Backend!") = vbYes Then
               
               DoCmd.OpenForm "ap_CompactDatabase", acForm
               
            Else
               
               flgLeaveApplication = True
            
            End If
         
       End Select
      
       '-- Section 7: Leave the application if requested
       If flgLeaveApplication Then
          Application.Quit
          Exit Function
       End If
      
       On Error Resume Next
      
       '-- Section 8: Let's try and open the first table again.
       dynSharedTables.MoveFirst
      
       Set dynTestTable = dbLocal.OpenRecor

KenjiSato

Option Compare Database
Option Explicit

Public Const apErrDeviceNotAvlble = 68
Public Const apErrFileNotFound = 3024
Public Const apErrPathNotValid = 3044
Public Const apErrTableNotFound = 3078
Public Const apErrComDlgCancel = 32755
Public Const apErrDBCorrupted1 = 3049
Public Const apErrDBCorrupted2 = 3428

Public pstrAppPath As String
Public pstrBackEndPath As String
Public pstrBackEndName As String

Public intRepEdited As Integer

Public flgLeaveApplication As Boolean
Function ap_AppInit()
   
    Dim dbLocal As Database, dbNet As Database
    Dim dynSharedTables As Recordset, dynTestTable As Recordset
    Dim intCurrError As Integer, strCurrError As String
         
    DoEvents
    DoCmd.Echo True, "Checking Connections..."
   
    flgLeaveApplication = False
   
    Set dbLocal = CurrentDb()
     
    pstrAppPath = CurrentProject.Path
    pstrBackEndName = _
            ap_GetDatabaseProp(dbLocal, "BackEndName")
    pstrBackEndPath = _
            ap_GetDatabaseProp(dbLocal, "LastBackEndPath")

    '-- Section 2: User requested to logout, quit the application
    If ap_LogOutCheck(pstrBackEndPath) Then
        
        Beep
        
        MsgBox "Maintenance is being performed on the backend" & _
            vbCrLf & vbCrLf & _
            "All users are requested to logout at this time.", _
             vbOKOnly + vbCritical, "Logging Out for Maintenance"
        
        Application.Quit
        
        Exit Function
    End If
   
    '-- Section 3: Open the table containing the list of
    '   linked tables
    Set dynSharedTables = dbLocal.OpenRecordset _
                    ("tblSharedTables", dbOpenDynaset)
      
    On Error Resume Next
   
    dynSharedTables.MoveLast
   
    Set dynTestTable = dbLocal.OpenRecordset _
                    (dynSharedTables!TableName, _
         dbOpenDynaset)
      
    intCurrError = 3428 'Err.Number
    strCurrError = Err.Description
      
    Do Until intCurrError = 0
      
       On Error GoTo Error_ap_App_Init
      
       Select Case intCurrError
         Case apErrFileNotFound, apErrTableNotFound, _
              apErrPathNotValid, apErrDeviceNotAvlble
      
            '-- Section 4: If the Data MDB is found in the
            '              App Directory, link the files.
         
             If Dir(pstrAppPath & "\" & pstrBackEndName) = _
                            pstrBackEndName Then
                 
                ap_LinkTables dbLocal, dynSharedTables, _
                            pstrAppPath & "\" & pstrBackEndName
                           
                pstrBackEndPath = pstrAppPath
                 
             Else
            
                '-- Section 5: Allow the user to locate the BackEnd MDB
                If Not ap_LocateBackend(dbLocal, dynSharedTables, _
                       strCurrError) Then
                   flgLeaveApplication = True
                End If
            
             End If
              
         Case apErrDBCorrupted1, apErrDBCorrupted2
            
            '-- Section 6: Backend Corrupted. Compact/Repair?
            Beep
            
            If MsgBox("The Backend Database is Corrupted." & vbCrLf & _
               vbCrLf & "Would you like to log users out and " & _
               " attempt to compact/repair it?", vbYesNo + vbCritical, _
               "Corrupted Backend!") = vbYes Then
               
               DoCmd.OpenForm "ap_CompactDatabase", acForm
               
            Else
               
               flgLeaveApplication = True
            
            End If
         
       End Select
      
       '-- Section 7: Leave the application if requested
       If flgLeaveApplication Then
          Application.Quit
          Exit Function
       End If
      
       On Error Resume Next
      
       '-- Section 8: Let's try and open the first table again.
       dynSharedTables.MoveFirst
      
       Set dynTestTable = dbLocal.OpenRecor

KenjiSato

Function ap_LogOutCheck(strBackEndPath) As Integer
   
   On Error Resume Next
   ap_LogOutCheck = Dir(strBackEndPath & "\LogOut.FLG", vbHidden) = "LogOut.FLG"
   
End Function

Function ap_FormIsOpen(strFormName As String) As Integer

   Dim frmCurrent As Form
   
   For Each frmCurrent In Forms
      If frmCurrent.Name = strFormName Then
         ap_FormIsOpen = True
         Exit Function
      End If
   Next frmCurrent
   
End Function

Function ap_GetDatabaseProp(dbDatabase As Database, strPropertyName As String) As Variant
  
   ap_GetDatabaseProp = dbDatabase.Containers!Databases _
         .Documents("UserDefined").Properties(strPropertyName).Value
   
End Function
Sub ap_SetDatabaseProp(dbDatabase As Database, strPropertyName As String, varValue As Variant)
   
   dbDatabase.Containers!Databases.Documents("UserDefined").Properties(strPropertyName).Value = varValue

End Sub


Public Sub ap_LinkTables(dbLocal, dynSharedTables, strDataMDB As String)
   
    Dim tdfCurrent As TableDef
    Dim flgAddTable As Boolean
    Dim intTotalTbls As Integer
    Dim intCurrTbl As Integer
   
    On Error GoTo Err_LinkTables
   
    '-- Get the total number of linked tables, then display the progress meter.
    dynSharedTables.MoveLast
    intTotalTbls = dynSharedTables.RecordCount
    dynSharedTables.MoveFirst
   
    SysCmd acSysCmdInitMeter, "Linking Tables....", intTotalTbls
   
    intCurrTbl = 1
   
    Do Until dynSharedTables.EOF
            
        '-- Update the progress meter
        SysCmd acSysCmdUpdateMeter, intCurrTbl
        
        '-- Attempt to open the current link
        On Error Resume Next
        Set tdfCurrent = dbLocal.TableDefs(dynSharedTables!TableName)
        
        flgAddTable = Err.Number
        
        On Error GoTo Err_LinkTables
        
        '-- If there was an error, create the link from scratch,
        '-- otherwise, just update the connect string
        If flgAddTable Then
            
            Set tdfCurrent = dbLocal.CreateTableDef(dynSharedTables!TableName)
            tdfCurrent.SourceTableName = dynSharedTables!TableName
            tdfCurrent.Connect = ";DATABASE=" & strDataMDB
            CurrentDb.TableDefs.Append tdfCurrent
        
        Else
            
            tdfCurrent.Connect = ";DATABASE=" & strDataMDB
            tdfCurrent.RefreshLink
                    
        End If
                  
        dynSharedTables.MoveNext
        intCurrTbl = intCurrTbl + 1
        
    Loop
   
Exit_LinkTables:

    SysCmd acSysCmdRemoveMeter
   
    Exit Sub

Err_LinkTables:
   
    Resume Exit_LinkTables


End Sub

Public Sub ap_LogOutRemove()
   
    On Error Resume Next
   
    SetAttr pstrBackEndPath & "\LogOut.FLG", vbNormal
    Kill pstrBackEndPath & "\LogOut.FLG"

End Sub

Public Sub ap_LogOutCreate()
   
    On Error Resume Next
   
    '-- Create flag file
    Open pstrBackEndPath & "\LogOut.FLG" For Output Shared As #1
    Close #1
    SetAttr pstrBackEndPath & "\LogOut.FLG", vbHidden

End Sub

Public Function ap_LocateBackend(dbLocal, dynSharedTables, strCurrError) As Boolean
   
    Dim ocxDialog As Object
   
    ap_LocateBackend = True
   
    DoCmd.Echo True
    Beep
   
    If MsgBox("A problem has occurred accessing the linked tables." & _
         vbCrLf & vbCrLf & "The error was: " & strCurrError & vbCrLf & _
         vbCrLf & "Would you like to locate the backend?", vbCritical + _
         vbYesNo, "Error with Backend") = vbYes Then
      
       Dim strFileName As String
       strFileName = ap_FileOpen("Locate backend database", pstrBackEndName)
        
       If Len(strFileName) <> 0 Then
          DoEvents
          ap_LinkTables dbLocal, dynSharedTables, strFileName
          pstrBackEndPath = Left$(strFileName, _
                                InStrRev(strFileName, "\"))
            
       Else
   
          ap_LocateBackend = False
           
       End If
        
    El

KenjiSato

Function ap_LogOutCheck(strBackEndPath) As Integer
   
   On Error Resume Next
   ap_LogOutCheck = Dir(strBackEndPath & "\LogOut.FLG", vbHidden) = "LogOut.FLG"
   
End Function

Function ap_FormIsOpen(strFormName As String) As Integer

   Dim frmCurrent As Form
   
   For Each frmCurrent In Forms
      If frmCurrent.Name = strFormName Then
         ap_FormIsOpen = True
         Exit Function
      End If
   Next frmCurrent
   
End Function

Function ap_GetDatabaseProp(dbDatabase As Database, strPropertyName As String) As Variant
  
   ap_GetDatabaseProp = dbDatabase.Containers!Databases _
         .Documents("UserDefined").Properties(strPropertyName).Value
   
End Function
Sub ap_SetDatabaseProp(dbDatabase As Database, strPropertyName As String, varValue As Variant)
   
   dbDatabase.Containers!Databases.Documents("UserDefined").Properties(strPropertyName).Value = varValue

End Sub


Public Sub ap_LinkTables(dbLocal, dynSharedTables, strDataMDB As String)
   
    Dim tdfCurrent As TableDef
    Dim flgAddTable As Boolean
    Dim intTotalTbls As Integer
    Dim intCurrTbl As Integer
   
    On Error GoTo Err_LinkTables
   
    '-- Get the total number of linked tables, then display the progress meter.
    dynSharedTables.MoveLast
    intTotalTbls = dynSharedTables.RecordCount
    dynSharedTables.MoveFirst
   
    SysCmd acSysCmdInitMeter, "Linking Tables....", intTotalTbls
   
    intCurrTbl = 1
   
    Do Until dynSharedTables.EOF
            
        '-- Update the progress meter
        SysCmd acSysCmdUpdateMeter, intCurrTbl
        
        '-- Attempt to open the current link
        On Error Resume Next
        Set tdfCurrent = dbLocal.TableDefs(dynSharedTables!TableName)
        
        flgAddTable = Err.Number
        
        On Error GoTo Err_LinkTables
        
        '-- If there was an error, create the link from scratch,
        '-- otherwise, just update the connect string
        If flgAddTable Then
            
            Set tdfCurrent = dbLocal.CreateTableDef(dynSharedTables!TableName)
            tdfCurrent.SourceTableName = dynSharedTables!TableName
            tdfCurrent.Connect = ";DATABASE=" & strDataMDB
            CurrentDb.TableDefs.Append tdfCurrent
        
        Else
            
            tdfCurrent.Connect = ";DATABASE=" & strDataMDB
            tdfCurrent.RefreshLink
                    
        End If
                  
        dynSharedTables.MoveNext
        intCurrTbl = intCurrTbl + 1
        
    Loop
   
Exit_LinkTables:

    SysCmd acSysCmdRemoveMeter
   
    Exit Sub

Err_LinkTables:
   
    Resume Exit_LinkTables


End Sub

Public Sub ap_LogOutRemove()
   
    On Error Resume Next
   
    SetAttr pstrBackEndPath & "\LogOut.FLG", vbNormal
    Kill pstrBackEndPath & "\LogOut.FLG"

End Sub

KenjiSato

Function ap_LogOutCheck(strBackEndPath) As Integer
   
   On Error Resume Next
   ap_LogOutCheck = Dir(strBackEndPath & "\LogOut.FLG", vbHidden) = "LogOut.FLG"
   
End Function

Function ap_FormIsOpen(strFormName As String) As Integer

   Dim frmCurrent As Form
   
   For Each frmCurrent In Forms
      If frmCurrent.Name = strFormName Then
         ap_FormIsOpen = True
         Exit Function
      End If
   Next frmCurrent
   
End Function

Function ap_GetDatabaseProp(dbDatabase As Database, strPropertyName As String) As Variant
  
   ap_GetDatabaseProp = dbDatabase.Containers!Databases _
         .Documents("UserDefined").Properties(strPropertyName).Value
   
End Function
Sub ap_SetDatabaseProp(dbDatabase As Database, strPropertyName As String, varValue As Variant)
   
   dbDatabase.Containers!Databases.Documents("UserDefined").Properties(strPropertyName).Value = varValue

End Sub


Public Sub ap_LinkTables(dbLocal, dynSharedTables, strDataMDB As String)
   
    Dim tdfCurrent As TableDef
    Dim flgAddTable As Boolean
    Dim intTotalTbls As Integer
    Dim intCurrTbl As Integer
   
    On Error GoTo Err_LinkTables
   
    '-- Get the total number of linked tables, then display the progress meter.
    dynSharedTables.MoveLast
    intTotalTbls = dynSharedTables.RecordCount
    dynSharedTables.MoveFirst
   
    SysCmd acSysCmdInitMeter, "Linking Tables....", intTotalTbls
   
    intCurrTbl = 1
   
    Do Until dynSharedTables.EOF
            
        '-- Update the progress meter
        SysCmd acSysCmdUpdateMeter, intCurrTbl
        
        '-- Attempt to open the current link
        On Error Resume Next
        Set tdfCurrent = dbLocal.TableDefs(dynSharedTables!TableName)
        
        flgAddTable = Err.Number
        
        On Error GoTo Err_LinkTables
        
        '-- If there was an error, create the link from scratch,
        '-- otherwise, just update the connect string
        If flgAddTable Then
            
            Set tdfCurrent = dbLocal.CreateTableDef(dynSharedTables!TableName)
            tdfCurrent.SourceTableName = dynSharedTables!TableName
            tdfCurrent.Connect = ";DATABASE=" & strDataMDB
            CurrentDb.TableDefs.Append tdfCurrent
        
        Else
            
            tdfCurrent.Connect = ";DATABASE=" & strDataMDB
            tdfCurrent.RefreshLink
                    
        End If
                  
        dynSharedTables.MoveNext
        intCurrTbl = intCurrTbl + 1
        
    Loop
   
Exit_LinkTables:

    SysCmd acSysCmdRemoveMeter
   
    Exit Sub

Err_LinkTables:
   
    Resume Exit_LinkTables


End Sub

cg1

倒，爆长

KenjiSato

Function ap_LogOutCheck(strBackEndPath) As Integer
   
   On Error Resume Next
   ap_LogOutCheck = Dir(strBackEndPath & "\LogOut.FLG", vbHidden) = "LogOut.FLG"
   
End Function

Function ap_FormIsOpen(strFormName As String) As Integer

   Dim frmCurrent As Form
   
   For Each frmCurrent In Forms
      If frmCurrent.Name = strFormName Then
         ap_FormIsOpen = True
         Exit Function
      End If
   Next frmCurrent
   
End Function

Function ap_GetDatabaseProp(dbDatabase As Database, strPropertyName As String) As Variant
  
   ap_GetDatabaseProp = dbDatabase.Containers!Databases _
         .Documents("UserDefined").Properties(strPropertyName).Value
   
End Function