日志代码和属性引用-优快云博客

日志代码和属性引用第 1部分-目录第 1部分-目录第 2部分-简介第 3部分-表布局第 4部分-代码到日志代码第 5部分-代码到日志属性第 6部分-实现说明第 7部分-代码无需自动启动任何代码 附件即可 打开数据库 -RefLog.Zip

-------------------------------------------------- ------------------------------

第2节-简介

您是否曾经需要更改过项目的一部分，例如，如何在一个表中设计一个或多个字段，但是不确定项目的哪一部分引用了这些项目？担心项目中一些很少使用的部分会被您正在准备的更改破坏吗？你不是一个人！

首先，我要说MS Access具有Documenter功能（

工具 | 分析功能区之前的Documenter和数据库工具 | 之后提供数据库文档器 。）适用于许多版本，可用于提供许多信息。不幸的是，这可能很笨拙，并且由于某些文本被包裹而容易丢失信息:-(

我打算介绍的是一种将所有CODE登录到一对表中并将所有属性引用登录到单独的表中的方法。利用表中的可用数据，您可以使用各种显示和过滤选项来查看要处理的内容。所附模板数据库中已包含一些查询，作为可以完成的示例。

注意如果尚不存在，则记录代码的过程将创建一个文件夹（相对于当前项目路径的... \ Macros \）。除非以前没有日志记录过程，否则将在日志记录过程完成后将其删除。注意该项目无法处理由旧工具栏上的命令按钮或新功能区触发的逻辑。也可能有仅由设计人员使用过的例程，这些例程可以从VBIDE的即时窗格中调用它们。因此，您在项目中可能有没有明显引用的代码，但是这些代码仍在使用且很重要。希望在这种情况下，可以将使用情况清楚记录在案。

-------------------------------------------------- ------------------------------

第3部分-表格布局

这些表包含在随附的数据库中，其中一个是BE。

表名称= [ lupControl ] -控件类型的内部访问值。

ControlID; Autonumber; PK
Name; String

表名称= [ lupProperty ] -按类型的属性-当前仅包括事件属性。

PropertyID; Autonumber; PK
PName; String
PType; String; Type of property - Event; Data; Format; Other

上面的两个表包含预加载的数据，这些数据对于项目的工作非常重要。

下表存储了收集的信息。始终将其清空，并在使用前将BE文件压实并进行维修。

表名称= [ tblProperty ] -分层属性（对象）。

PropID; Autonumber; PK
PParent; Numeric; Long; FK to [tblProperty]; Parent of object.  None for database.
PType; String; Database; Group; Object; Section; Control; Property.
PName; String
PVal; String

表名称= [ tblCode ] -主要代码项。

CodeID; Autonumber; PK
CodeType; String
CodeName; String

表名称= [ tblCodeLine ] -单独的代码行。

CodeLineID; Autonumber; PK
CodeID; Numeric; Long; FK to [tblCode]
LineNo; Numeric; Long
LineData; Memo

-------------------------------------------------- ------------------------------第4部分-代码到日志代码

注意此代码需要引用库“ Visual Basic for Applications Extensibility 5.3”。

模块名称= [ modExtra ]

Option Compare Database
Option Explicit 
'References required.
'Visual Basic For Applications Extensibility 5.3. 
'Objects used across the code.
Private appAccess As Access.Application
Private dbThis As DAO.Database, dbThat As DAO.Database
Private rsVar As DAO.Recordset 
'LogAll() sets dbVar from strDB and calls other procedures to log all refs.
Public Sub LogAll(strBE As String _
                , strDB As String _
                , Optional ByVal strPW As String = "")
    Dim intAttr As Integer
    Dim strMsgs As String
    Dim frmProgress As Form_frmProgress 
    ' Set up and use frmProgress to show what's happening
    strMsgs = "Clearing and compacting Back-End data file.~" _
            & "Opening selected database (Set R/O first).~" _
            & "Prepare for logging of all modules, macros and queries.~" _
            & "Log all modules.~" _
            & "Log all macros.~" _
            & "Log all queries.~" _
            & "Log properties for all Forms and their objects " _
            & "(Sections, Controls, etc).~" _
            & "Log properties for all Reports and their objects " _
            & "(Sections, Controls, etc)."
    Set frmProgress = ProgressInit(strMsgs:=strMsgs, intDelSecs:=10)
    With frmProgress
        'Step 1.
        ' Clear down and compact BE DB
        Set dbThis = CurrentDb()
        With dbThis
            Call .Execute("DELETE * FROM [tblCode]", dbFailOnError)
            Call .Execute("DELETE * FROM [tblProperty]", dbFailOnError)
            Call CompactDb(strDB:=strBE)
        End With 
        'Step 2.
        Call .SetStep(intStep:=2)
    End With
    ' GetAttr() fails if in Sandbox mode so we assume RO
    intAttr = vbReadOnly
    On Error Resume Next
    intAttr = GetAttr(strDB)
    On Error GoTo 0
    If (intAttr And vbReadOnly) = 0 Then _
        Call SetAttr(PathName:=strDB, Attributes:=(intAttr Or vbReadOnly))
    Set appAccess = OpenBypass(strDB:=strDB, blnExclusive:=False, strPW:=strPW)
    With appAccess
        .Visible = False
        Set dbThat = appAccess.CurrentDb()
        Call LogAllCode(frmProgress)
        Call LogProperties(frmProgress)
        Call .CloseCurrentDatabase
        Call appAccess.Quit(Option:=acQuitSaveNone)
        Set dbThat = Nothing
        Set appAccess = Nothing
    End With
    If (intAttr And vbReadOnly) = 0 Then _
        Call SetAttr(PathName:=strDB, Attributes:=intAttr)
    ' All done - Ready to close
    Call frmProgress.SetStep(intStep:=-8)
End Sub 
'LogAllCode() logs all VBA, macro & SQL code into
'   tables [tblCode] & [tblCodeLine].
Public Sub LogAllCode(frmProgress As Form_frmProgress)
    Dim intFrom As Integer
    Dim lngCodeID As Long, lngLineNo As Long, lngLines As Long
    Dim strFolder As String, strTFile As String, strBuf As String
    Dim strModules As String, strWork As String, strName As String
    Dim blnFolExist As Boolean, blnStd As Boolean
    Dim varWork As Variant
    Dim aoCode As AccessObject
    Dim rsCodeLine As DAO.Recordset
    Dim qdfVar As DAO.QueryDef
    Dim colComponents As VBIDE.VBComponents
    Dim modVar As VBIDE.CodeModule 
    'Step 3.
    Call frmProgress.SetStep(intStep:=3)
    strFolder = CurrentProject.Path & "\Macros\"
    blnFolExist = FolderExist(strFolder)
    If Not blnFolExist Then Call MkDir(strFolder)
    strTFile = strFolder & "Temp.Txt"
    With appAccess
        'Set up strModules for use later.
        With .VBE
            Set colComponents = IIf(.VBProjects.Count > 0 _
                                  , .ActiveVBProject.VBComponents _
                                  , Nothing)
        End With
        If Not colComponents Is Nothing Then
            With .CurrentProject
                For Each aoCode In .AllForms
                    strModules = MultiReplace("%M;Form Module,Form_%N" _
                                            , "%M", strModules _
                                            , "%N", aoCode.Name)
                Next aoCode
                For Each aoCode In .AllReports
                    strModules = MultiReplace("%M;Report Module,Report_%N" _
                                            , "%M", strModules _
                                            , "%N", aoCode.Name)
                Next aoCode
                For Each aoCode In .AllModules
                    strName = aoCode.Name
                    blnStd = (colComponents(strName).Type = vbext_ct_StdModule)
                    strWork = IIf(blnStd, "Standard", "Class")
                    strModules = MultiReplace("%M;%T Module,%N" _
                                            , "%M", strModules _
                                            , "%T", strWork _
                                            , "%N", strName)
                Next aoCode
            End With
            strModules = Mid(strModules, 2)
        End If 
        'Step 4.
        Call frmProgress.SetStep(intStep:=4)
        With dbThis
            With .TableDefs("tblCodeLine")
                Set rsCodeLine = .OpenRecordset(Type:=dbOpenDynaset _
                                              , Options:=dbAppendOnly)
            End With
            With .TableDefs("tblCode").OpenRecordset(Type:=dbOpenDynaset _
                                                   , Options:=dbAppendOnly)
                For Each varWork In Split(strModules, ";")
                    strName = Split(varWork, ",")(1)
                    Call .AddNew
                    !CodeName = strName
                    !CodeType = Split(varWork, ",")(0)
                    lngCodeID = !CodeID
                    Call .Update
                    On Error Resume Next
                    Set modVar = colComponents(strName).CodeModule
                    lngLines = IIf(Err.Number = 0, modVar.CountOfLines, 0)
                    On Error GoTo 0
                    With rsCodeLine
                        For lngLineNo = 1 To lngLines
                            strBuf = modVar.Lines(StartLine:=lngLineNo _
                                                , Count:=1)
                            Call .AddNew
                            !CodeID = lngCodeID
                            !LineNo = lngLineNo
                            !LineData = IIf(strBuf = "", Null, strBuf)
                            Call .Update
                        Next lngLineNo
                    End With
                Next varWork 
                'Step 5.
                Call frmProgress.SetStep(intStep:=5)
                For Each aoCode In appAccess.CurrentProject.AllMacros
                    Call .AddNew
                    !CodeName = aoCode.Name
                    !CodeType = "Macro"
                    lngCodeID = !CodeID
                    Call .Update
                    ' For ACCDB files this command exports the data as Unicode.
                    ' It sometimes fails due to being called too soon.
                    On Error Resume Next
                    Do
                        If Err > 0 Then DoEvents
                        Call Err.Clear
                        Call appAccess.SaveAsText(ObjectType:=acMacro _
                                                , ObjectName:=aoCode.Name _
                                                , FileName:=strTFile)
                    Loop Until Err = 0
                    On Error GoTo 0
                    lngLineNo = 0
                    intFrom = FreeFile()
                    Open strTFile For Input Access Read Lock Write As #intFrom
                    strBuf = Input(2, #intFrom)
                    'Unicode files (from ACCDB) start with FF FE.
                    If strBuf <> Chr(&HFF) & Chr(&HFE) Then Seek #intFrom, 1
                    With rsCodeLine
                        Do Until EOF(intFrom)
                            lngLineNo = lngLineNo + 1
                            Line Input #intFrom, strBuf
                            Call .AddNew
                            !CodeID = lngCodeID
                            !LineNo = lngLineNo
                            !LineData = IIf(strBuf = "", Null, strBuf)
                            Call .Update
                        Loop
                        Close #intFrom
                    End With
                    Call KillFile(strFile:=strTFile, blnIgnore:=True)
                Next aoCode 
                'Step 6.
                Call frmProgress.SetStep(intStep:=6)
                For Each qdfVar In dbThat.QueryDefs
                    Call .AddNew
                    !CodeName = qdfVar.Name
                    !CodeType = "QueryDef"
                    lngCodeID = !CodeID
                    Call .Update
                    strWork = GetSQL(strQuery:=qdfVar.Name, dbVar:=dbThat)
                    Do While Right(strWork, 2) = vbNewLine
                        strWork = Left(strWork, Len(strWork) - 2)
                    Loop
                    With rsCodeLine
                        lngLineNo = 0
                        For Each varWork In Split(strWork, vbNewLine)
                            strBuf = varWork
                            lngLineNo = lngLineNo + 1
                            Call .AddNew
                            !CodeID = lngCodeID
                            !LineNo = lngLineNo
                            !LineData = IIf(strBuf = "", Null, strBuf)
                            Call .Update
                        Next varWork
                    End With
                Next qdfVar
                Call .Close
            End With
            Call rsCodeLine.Close
            Set rsCodeLine = Nothing
            If Exist(strTFile) Then _
                Call KillFile(strFile:=strTFile, blnIgnore:=True)
            If Not blnFolExist Then Call RmDir(strFolder)
        End With
    End With
End Sub

正如您将看到的，其中涉及到相当多的代码，因此我将其限制为对将代码记录到此处的情况的一般解释。 LogAllCode（）是记录代码的主要过程。它通过访问VBIDE（V isual 乙 ASIC用于应用I ntegrated d才有发展ënvironment）各自的代码中引用有线和检查处理VBA代码。这适用于标准模块以及类和对象（窗体/报表）模块。除了VBA代码外，还需要查看Macros和QueryDefs。

宏通过使用处理

SaveAsText（）将宏的文本版本保存到文件中。然后读取该文件并将其保存到表中。

QueryDefs很有趣，因为它们不仅涵盖设计人员手动创建的内容，而且还涵盖在窗体或报表中创建任何SQL时自动为您创建的许多内容。因此，QueryDefs集合将项目中存储的所有SQL整合在一起，而不是使用VBA代码即时创建的任何SQL。这对于查找所有参考非常有用。 QueryDef有一个

使用GetSQL（）查询的.SQL属性（有关为什么不直接使用它的原因，请参阅Access QueryDefs保存错误的子查询SQL ）。然后将该字符串按行分割并保存在表中。

-------------------------------------------------- ------------------------------

第5部分-记录属性的代码

有关模块的第一部分，请参见上一节。该代码从同一模块（modExtra）中的代码开始。

'LogProperties() loads (into [tblProperty]) all the Form & Report objects and
'   their event properties.
Public Sub LogProperties(frmProgress As Form_frmProgress _
                       , Optional strPropType As String = "Event")
    Dim lngDB As Long, lngGroup As Long, lngObject As Long, lngSection As Long
    Dim lngX As Long
    Dim strName As String
    Dim blnOpen As Boolean
    Dim objVar As Object
    Dim aoVar As AccessObject
    Dim sctVar As Section
    Dim ctlVar As Control 
    'Step 7.
    Call frmProgress.SetStep(intStep:=7)
    With appAccess.CurrentProject
        Set rsVar = dbThis.OpenRecordset(Name:="tblProperty" _
                                       , Type:=dbOpenDynaset _
                                       , Options:=dbDenyWrite)
        strName = .Name
        With rsVar
            Call .AddNew
            !PType = "Database"
            !PName = strName
            lngDB = !PropID
            Call .Update
            Call .AddNew
            !PParent = lngDB
            !PType = "Group"
            !PName = "Forms"
            lngGroup = !PropID
            Call .Update
        End With
        For Each aoVar In .AllForms
            strName = aoVar.Name
            With appAccess
                blnOpen = IsOpen(strName, acForm)
                If Not blnOpen Then _
                    Call .DoCmd.OpenForm(FormName:=strName _
                                       , View:=acDesign _
                                       , WindowMode:=acHidden)
                Set objVar = .Forms(strName)
            End With
            lngObject = LoadRefs(objVar:=objVar _
                               , lngParent:=lngGroup _
                               , strPropType:=strPropType)
            For lngX = acDetail To acPageFooter
                'Horribly kludgy interface with Sections :-(
                On Error Resume Next
                Set sctVar = Nothing
                Set sctVar = objVar.Section(lngX)
                On Error GoTo 0
                If Not sctVar Is Nothing Then
                    lngSection = LoadRefs(objVar:=sctVar, lngParent:=lngObject)
                    For Each ctlVar In sctVar.Controls
                        Call LoadRefs(objVar:=ctlVar, lngParent:=lngSection)
                    Next ctlVar
                End If
            Next lngX
            If Not blnOpen Then _
                Call appAccess.DoCmd.Close(ObjectType:=acForm _
                                         , ObjectName:=strName _
                                         , Save:=acSaveNo)
        Next aoVar
        With rsVar
            Call .AddNew
            !PParent = lngDB
            !PType = "Group"
            !PName = "Reports"
            lngGroup = !PropID
            Call .Update
        End With 
        'Step 8.
        Call frmProgress.SetStep(intStep:=8)
        For Each aoVar In .AllReports
            strName = aoVar.Name
            With appAccess
                blnOpen = IsOpen(strName, acReport)
                If Not blnOpen Then _
                    Call .DoCmd.OpenReport(ReportName:=strName _
                                         , View:=acDesign _
                                         , WindowMode:=acHidden)
                Set objVar = .Reports(strName)
            End With
            lngObject = LoadRefs(objVar:=objVar, lngParent:=lngGroup)
            For lngX = acDetail To 9999
                'Horribly kludgy interface with Sections :-(
                On Error Resume Next
                Set sctVar = Nothing
                Set sctVar = objVar.Section(lngX)
                On Error GoTo 0
                If sctVar Is Nothing Then
                    If lngX > acPageFooter Then Exit For
                Else
                    lngSection = LoadRefs(objVar:=sctVar, lngParent:=lngObject)
                    For Each ctlVar In sctVar.Controls
                        Call LoadRefs(objVar:=ctlVar, lngParent:=lngSection)
                    Next ctlVar
                End If
            Next lngX
            If Not blnOpen Then _
                Call appAccess.DoCmd.Close(ObjectType:=acReport _
                                         , ObjectName:=strName _
                                         , Save:=acSaveNo)
        Next aoVar
        Call rsVar.Close
        Set rsVar = Nothing
    End With
End Sub 
'LoadRefs() loads (into [tblProperty]) all the properties and sub-properties of
'   the objVar.
'   If strPropType is passsed then only handles properties of that type.
Private Function LoadRefs(objVar As Object _
                        , ByVal lngParent As Long _
                        , Optional ByVal strPropType As String = "All") As Long
    Static strValid As String
    Dim strSQL As String, strPType As String, strPName As String
    Dim prpVar As DAO.Property 
    If strValid = "" Then
        If strPType = "All" Then
            strSQL = "lupProperty"
        Else
            strSQL = MultiReplace("SELECT *%L" _
                                & "FROM   [lupProperty]%L" _
                                & "WHERE  ([PType]='%T')" _
                                , "%T", strPropType _
                                , "%L", vbNewLine)
        End If
        strValid = ","
        With dbThis.OpenRecordset(Name:=strSQL, Type:=dbOpenSnapshot)
            Do Until .EOF
                strValid = strValid & !PName & ","
                Call .MoveNext
            Loop
            Call .Close
        End With
    End If
    Select Case True
    Case TypeOf objVar Is Form
        strPType = "Form"
    Case TypeOf objVar Is Report
        strPType = "Report"
    Case TypeOf objVar Is Section
        strPType = "Section"
    Case TypeOf objVar Is Control
        strPType = "Control"
    End Select
    With rsVar
        Call .AddNew
        !PParent = lngParent
        !PType = strPType
        !PName = objVar.Name
        lngParent = !PropID
        Call .Update
        LoadRefs = lngParent
    End With
    For Each prpVar In objVar.Properties
        strPName = prpVar.Name
        If InStr(strValid, "," & strPName & ",") > 0 Then
            If prpVar.Value > "" Then
                With rsVar
                    Call .AddNew
                    !PParent = lngParent
                    !PType = "Property"
                    !PName = strPName
                    !PVal = prpVar.Value
                    Call .Update
                End With
            End If
        End If
    Next prpVar
End Function 
'IsOpen() returns true if strName is an open object.
'Redo using appAccess.
Public Function IsOpen(strName As String, lngType As Long) As Boolean
    Dim objColl As Object, objVar As Object 
    With appAccess
        Select Case lngType
        Case acForm
            Set objColl = .Forms
        Case acReport
            Set objColl = .Reports
        End Select
        For Each objVar In objColl
            If strName = objVar.Name Then
                IsOpen = True
                Exit Function
            End If
        Next objVar
    End With
End Function

LogProperties（）是记录属性的主要过程。它可以处理从主数据库到控件属性的对象类型。该代码被递归调用以记录该结构，并以完整的层次结构显示在qryProperty中 。窗体和报表对象具有节和控件，所有这些都具有属性。

属性很重要，因为它们可以指示在何处调用代码和宏。例如，如果您要标识项目中不再使用的项目，那么拥有所有事件引用的表可能会非常有用。

-------------------------------------------------- ------------------------------

第6部分-实施和使用说明

要尝试此操作，只需下载文件，将数据库提取到一个文件夹中（一起），然后运行RefLog.Accdb。您将看到它可以做什么以及向您提供哪些信息的基本说明。

要在您自己的数据库上使用此功能，请浏览至数据库文件，然后输入密码（如果有的话）。根据项目的大小，日志记录过程可能需要几分钟或几小时。我有一个非常庞大和复杂的数据库，其中包含数百个对象，并且花了二十分钟才能完成。我的一个更直接的数据库花了几个。无论花费多长时间，都会有一个进度表，指示您在流程中的下落。

记录完所有数据后，从主表单中显示两个查询。我建议您最大化它们以提供最佳观看效果。之后，您可以使用标准搜索和过滤来仅显示您感兴趣的行。

-------------------------------------------------- ------------------------------

第7部分-无需自动启动任何代码即可打开数据库的代码

该项目的一个非常重要的部分是

使用OpenBypass（）过程以CurrentDb的形式打开数据库，而无需运行任何自动启动代码。相当于按住Shift或Bypass键。这是使用下面的代码完成的，并在我的视频访问打开旁路（cc）中进行了深入讨论： 模块名称= [ OpenBypass ]

Option Compare Database
Option Explicit 
'Windows API Variable Prefixes
'cb = Count of Bytes (32-bit)
'w  = Word (16-bit)
'dw = Double Word (32-bit)
'lp = Long Pointer (32-bit)
'b  = Boolean (32-bit)
'h  = Handle (32-bit)
'ul = Unsigned Long (32-bit) 
Private Const conShift As Integer = &H10 
Private Declare Function GetKeyboardState Lib "user32" _
                            (ByRef abytKeys As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" _
                            (ByRef abytKeys As Byte) As Long
Private Declare Function SetForegroundWindow Lib "user32" _
                            (ByVal lngWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" _
                            (ByVal lngWnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" _
                            (ByVal lngWnd As Long _
                           , ByRef lngProcessId As Long) As Long
Private Declare Function AttachThreadInput Lib "user32" _
                            (ByVal lngIDAttach As Long _
                           , ByVal lngIDAttachTo As Long _
                           , ByVal lngAttach As Long) As Long 
'OpenBypass() creates a new instance of Access and opens strDB (using strPW
'   if passed) without any auto-start features triggered (AutoExec macro or
'   Startup form/page).
'   It returns the new Access application.
Public Function OpenBypass(ByVal strDB As String _
                         , Optional blnExclusive As Boolean = False _
                         , Optional strPW As String = "") _
                           As Access.Application
    Dim lngThis As Long, lngThat As Long
    Dim abytKeys(0 To 255) As Byte, bytVar As Byte 
    ' Create new automation instance of Access
    Set OpenBypass = CreateObject("Access.Application")
    With OpenBypass
        .Visible = True
        ' Attach to process
        lngThis = GetWindowThreadProcessId(hWndAccessApp, ByVal 0)
        lngThat = GetWindowThreadProcessId(.hWndAccessApp, ByVal 0)
        Call AttachThreadInput(lngThis, lngThat, True)
        ' First give new application focus
        Call SetForegroundWindow(.hWndAccessApp)
        Call SetFocus(.hWndAccessApp)
        ' Set Shift state
        Call GetKeyboardState(abytKeys(0))
        bytVar = abytKeys(conShift)
        abytKeys(conShift) = &H80
        Call SetKeyboardState(abytKeys(0))
        ' Open strDB with auto-start features disabled
        Call .OpenCurrentDatabase(Filepath:=strDB _
                                , Exclusive:=blnExclusive _
                                , bstrPassword:=strPW)
        ' Revert keyboard state
        abytKeys(conShift) = bytVar
        Call SetKeyboardState(abytKeys(0))
        ' Detach threads
        Call AttachThreadInput(lngThis, lngThat, False)
    End With
End Function