423,688 Members | 1,879 Online
Bytes IT Community
Submit an Article
Got Smarts?
Share your bits of IT knowledge by writing an article on Bytes.

Log Code and Property References

NeoPa
Expert Mod 15k+
P: 31,084
Log Code and Property References

SECTION 1 - TABLE OF CONTENTS

SECTION 1 - TABLE OF CONTENTS
SECTION 2 - INTRODUCTION
SECTION 3 - TABLE LAYOUTS
SECTION 4 - CODE TO LOG CODE
SECTION 5 - CODE TO LOG PROPERTIES
SECTION 6 - IMPLEMENTATION INSTRUCTIONS
SECTION 7 - CODE TO OPEN DATABASE WITHOUT AUTOSTARTING ANY CODE

Attachment - RefLog.Zip

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

SECTION 2 - INTRODUCTION

Have you ever needed to change a part of your project, for instance how one or more fields are designed in a table, but aren't sure which parts of your project are referencing these items? Worried that some very rarely used part of your project will be broken by the changes you're preparing? You are not alone!

Let me start by saying that MS Access has had a Documenter feature (Tools | Analyze | Documenter prior to the ribbon and Database Tools | Database Documenter afterwards.) available for many versions that can be used to provide much of the information. Unfortunately, this can be clumsy to work with and has a tendency to lose information as some text gets wrapped :-(

What I plan to introduce is a way to log all CODE into a pair of tables and all property references into a separate table. With this data available in tables you can use all sorts of display and filtering options to see what you're dealing with. A couple of queries have been included in the attached template database as examples of what can be done.

NB. The process that logs the code creates a folder (...\Macros\ relative to the current project path) if it doesn't already exist. This is deleted when the logging process has finished unless there was already one there previously.

NB. This project doesn't handle logic which is triggered by a Command Button on an old toolbar or a new ribbon. It is also possible to have routines that are only ever used by the designer who may invoke them from the Immediate Pane in the VBIDE. Thus, you may have code in the project which has no apparent references, but which is nevertheless used and important. Hopefully, in such cases, that use will be documented clearly.

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

SECTION 3 - TABLE LAYOUTS

These tables are included in the attached databases, one of which is the BE.

Table Name=[lupControl] - Internal Access values for control types.
Expand|Select|Wrap|Line Numbers
  1. ControlID; Autonumber; PK
  2. Name; String
Table Name=[lupProperty] - Properties by Type - Currently only Event properties included.
Expand|Select|Wrap|Line Numbers
  1. PropertyID; Autonumber; PK
  2. PName; String
  3. PType; String; Type of property - Event; Data; Format; Other
The two tables above contain preloaded data which is important to the workings of the project.

The tables below store the information that is gathered. They are always emptied and the BE file where they are held compacted and repaired prior to use.

Table Name=[tblProperty] - Hierarchical properties (objects).
Expand|Select|Wrap|Line Numbers
  1. PropID; Autonumber; PK
  2. PParent; Numeric; Long; FK to [tblProperty]; Parent of object.  None for database.
  3. PType; String; Database; Group; Object; Section; Control; Property.
  4. PName; String
  5. PVal; String
Table Name=[tblCode] - Main code items.
Expand|Select|Wrap|Line Numbers
  1. CodeID; Autonumber; PK
  2. CodeType; String
  3. CodeName; String
Table Name=[tblCodeLine] - Individual lines of code.
Expand|Select|Wrap|Line Numbers
  1. CodeLineID; Autonumber; PK
  2. CodeID; Numeric; Long; FK to [tblCode]
  3. LineNo; Numeric; Long
  4. LineData; Memo
--------------------------------------------------------------------------------

SECTION 4 - CODE TO LOG CODE

NB. This code requires a reference to the library "Visual Basic For Applications Extensibility 5.3".

Module Name=[modExtra]
Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. 'References required.
  5. 'Visual Basic For Applications Extensibility 5.3.
  6.  
  7. 'Objects used across the code.
  8. Private appAccess As Access.Application
  9. Private dbThis As DAO.Database, dbThat As DAO.Database
  10. Private rsVar As DAO.Recordset
  11.  
  12. 'LogAll() sets dbVar from strDB and calls other procedures to log all refs.
  13. Public Sub LogAll(strBE As String _
  14.                 , strDB As String _
  15.                 , Optional ByVal strPW As String = "")
  16.     Dim intAttr As Integer
  17.     Dim strMsgs As String
  18.     Dim frmProgress As Form_frmProgress
  19.  
  20.     ' Set up and use frmProgress to show what's happening
  21.     strMsgs = "Clearing and compacting Back-End data file.~" _
  22.             & "Opening selected database (Set R/O first).~" _
  23.             & "Prepare for logging of all modules, macros and queries.~" _
  24.             & "Log all modules.~" _
  25.             & "Log all macros.~" _
  26.             & "Log all queries.~" _
  27.             & "Log properties for all Forms and their objects " _
  28.             & "(Sections, Controls, etc).~" _
  29.             & "Log properties for all Reports and their objects " _
  30.             & "(Sections, Controls, etc)."
  31.     Set frmProgress = ProgressInit(strMsgs:=strMsgs, intDelSecs:=10)
  32.     With frmProgress
  33.         'Step 1.
  34.         ' Clear down and compact BE DB
  35.         Set dbThis = CurrentDb()
  36.         With dbThis
  37.             Call .Execute("DELETE * FROM [tblCode]", dbFailOnError)
  38.             Call .Execute("DELETE * FROM [tblProperty]", dbFailOnError)
  39.             Call CompactDb(strDB:=strBE)
  40.         End With
  41.  
  42.         'Step 2.
  43.         Call .SetStep(intStep:=2)
  44.     End With
  45.     ' GetAttr() fails if in Sandbox mode so we assume RO
  46.     intAttr = vbReadOnly
  47.     On Error Resume Next
  48.     intAttr = GetAttr(strDB)
  49.     On Error GoTo 0
  50.     If (intAttr And vbReadOnly) = 0 Then _
  51.         Call SetAttr(PathName:=strDB, Attributes:=(intAttr Or vbReadOnly))
  52.     Set appAccess = OpenBypass(strDB:=strDB, blnExclusive:=False, strPW:=strPW)
  53.     With appAccess
  54.         .Visible = False
  55.         Set dbThat = appAccess.CurrentDb()
  56.         Call LogAllCode(frmProgress)
  57.         Call LogProperties(frmProgress)
  58.         Call .CloseCurrentDatabase
  59.         Call appAccess.Quit(Option:=acQuitSaveNone)
  60.         Set dbThat = Nothing
  61.         Set appAccess = Nothing
  62.     End With
  63.     If (intAttr And vbReadOnly) = 0 Then _
  64.         Call SetAttr(PathName:=strDB, Attributes:=intAttr)
  65.     ' All done - Ready to close
  66.     Call frmProgress.SetStep(intStep:=-8)
  67. End Sub
  68.  
  69. 'LogAllCode() logs all VBA, macro & SQL code into
  70. '   tables [tblCode] & [tblCodeLine].
  71. Public Sub LogAllCode(frmProgress As Form_frmProgress)
  72.     Dim intFrom As Integer
  73.     Dim lngCodeID As Long, lngLineNo As Long, lngLines As Long
  74.     Dim strFolder As String, strTFile As String, strBuf As String
  75.     Dim strModules As String, strWork As String, strName As String
  76.     Dim blnFolExist As Boolean, blnStd As Boolean
  77.     Dim varWork As Variant
  78.     Dim aoCode As AccessObject
  79.     Dim rsCodeLine As DAO.Recordset
  80.     Dim qdfVar As DAO.QueryDef
  81.     Dim colComponents As VBIDE.VBComponents
  82.     Dim modVar As VBIDE.CodeModule
  83.  
  84.     'Step 3.
  85.     Call frmProgress.SetStep(intStep:=3)
  86.     strFolder = CurrentProject.Path & "\Macros\"
  87.     blnFolExist = FolderExist(strFolder)
  88.     If Not blnFolExist Then Call MkDir(strFolder)
  89.     strTFile = strFolder & "Temp.Txt"
  90.     With appAccess
  91.         'Set up strModules for use later.
  92.         With .VBE
  93.             Set colComponents = IIf(.VBProjects.Count > 0 _
  94.                                   , .ActiveVBProject.VBComponents _
  95.                                   , Nothing)
  96.         End With
  97.         If Not colComponents Is Nothing Then
  98.             With .CurrentProject
  99.                 For Each aoCode In .AllForms
  100.                     strModules = MultiReplace("%M;Form Module,Form_%N" _
  101.                                             , "%M", strModules _
  102.                                             , "%N", aoCode.Name)
  103.                 Next aoCode
  104.                 For Each aoCode In .AllReports
  105.                     strModules = MultiReplace("%M;Report Module,Report_%N" _
  106.                                             , "%M", strModules _
  107.                                             , "%N", aoCode.Name)
  108.                 Next aoCode
  109.                 For Each aoCode In .AllModules
  110.                     strName = aoCode.Name
  111.                     blnStd = (colComponents(strName).Type = vbext_ct_StdModule)
  112.                     strWork = IIf(blnStd, "Standard", "Class")
  113.                     strModules = MultiReplace("%M;%T Module,%N" _
  114.                                             , "%M", strModules _
  115.                                             , "%T", strWork _
  116.                                             , "%N", strName)
  117.                 Next aoCode
  118.             End With
  119.             strModules = Mid(strModules, 2)
  120.         End If
  121.  
  122.         'Step 4.
  123.         Call frmProgress.SetStep(intStep:=4)
  124.         With dbThis
  125.             With .TableDefs("tblCodeLine")
  126.                 Set rsCodeLine = .OpenRecordset(Type:=dbOpenDynaset _
  127.                                               , Options:=dbAppendOnly)
  128.             End With
  129.             With .TableDefs("tblCode").OpenRecordset(Type:=dbOpenDynaset _
  130.                                                    , Options:=dbAppendOnly)
  131.                 For Each varWork In Split(strModules, ";")
  132.                     strName = Split(varWork, ",")(1)
  133.                     Call .AddNew
  134.                     !CodeName = strName
  135.                     !CodeType = Split(varWork, ",")(0)
  136.                     lngCodeID = !CodeID
  137.                     Call .Update
  138.                     On Error Resume Next
  139.                     Set modVar = colComponents(strName).CodeModule
  140.                     lngLines = IIf(Err.Number = 0, modVar.CountOfLines, 0)
  141.                     On Error GoTo 0
  142.                     With rsCodeLine
  143.                         For lngLineNo = 1 To lngLines
  144.                             strBuf = modVar.Lines(StartLine:=lngLineNo _
  145.                                                 , Count:=1)
  146.                             Call .AddNew
  147.                             !CodeID = lngCodeID
  148.                             !LineNo = lngLineNo
  149.                             !LineData = IIf(strBuf = "", Null, strBuf)
  150.                             Call .Update
  151.                         Next lngLineNo
  152.                     End With
  153.                 Next varWork
  154.  
  155.                 'Step 5.
  156.                 Call frmProgress.SetStep(intStep:=5)
  157.                 For Each aoCode In appAccess.CurrentProject.AllMacros
  158.                     Call .AddNew
  159.                     !CodeName = aoCode.Name
  160.                     !CodeType = "Macro"
  161.                     lngCodeID = !CodeID
  162.                     Call .Update
  163.                     ' For ACCDB files this command exports the data as Unicode.
  164.                     ' It sometimes fails due to being called too soon.
  165.                     On Error Resume Next
  166.                     Do
  167.                         If Err > 0 Then DoEvents
  168.                         Call Err.Clear
  169.                         Call appAccess.SaveAsText(ObjectType:=acMacro _
  170.                                                 , ObjectName:=aoCode.Name _
  171.                                                 , FileName:=strTFile)
  172.                     Loop Until Err = 0
  173.                     On Error GoTo 0
  174.                     lngLineNo = 0
  175.                     intFrom = FreeFile()
  176.                     Open strTFile For Input Access Read Lock Write As #intFrom
  177.                     strBuf = Input(2, #intFrom)
  178.                     'Unicode files (from ACCDB) start with FF FE.
  179.                     If strBuf <> Chr(&HFF) & Chr(&HFE) Then Seek #intFrom, 1
  180.                     With rsCodeLine
  181.                         Do Until EOF(intFrom)
  182.                             lngLineNo = lngLineNo + 1
  183.                             Line Input #intFrom, strBuf
  184.                             Call .AddNew
  185.                             !CodeID = lngCodeID
  186.                             !LineNo = lngLineNo
  187.                             !LineData = IIf(strBuf = "", Null, strBuf)
  188.                             Call .Update
  189.                         Loop
  190.                         Close #intFrom
  191.                     End With
  192.                     Call KillFile(strFile:=strTFile, blnIgnore:=True)
  193.                 Next aoCode
  194.  
  195.                 'Step 6.
  196.                 Call frmProgress.SetStep(intStep:=6)
  197.                 For Each qdfVar In dbThat.QueryDefs
  198.                     Call .AddNew
  199.                     !CodeName = qdfVar.Name
  200.                     !CodeType = "QueryDef"
  201.                     lngCodeID = !CodeID
  202.                     Call .Update
  203.                     strWork = GetSQL(strQuery:=qdfVar.Name, dbVar:=dbThat)
  204.                     Do While Right(strWork, 2) = vbNewLine
  205.                         strWork = Left(strWork, Len(strWork) - 2)
  206.                     Loop
  207.                     With rsCodeLine
  208.                         lngLineNo = 0
  209.                         For Each varWork In Split(strWork, vbNewLine)
  210.                             strBuf = varWork
  211.                             lngLineNo = lngLineNo + 1
  212.                             Call .AddNew
  213.                             !CodeID = lngCodeID
  214.                             !LineNo = lngLineNo
  215.                             !LineData = IIf(strBuf = "", Null, strBuf)
  216.                             Call .Update
  217.                         Next varWork
  218.                     End With
  219.                 Next qdfVar
  220.                 Call .Close
  221.             End With
  222.             Call rsCodeLine.Close
  223.             Set rsCodeLine = Nothing
  224.             If Exist(strTFile) Then _
  225.                 Call KillFile(strFile:=strTFile, blnIgnore:=True)
  226.             If Not blnFolExist Then Call RmDir(strFolder)
  227.         End With
  228.     End With
  229. End Sub
As you'll see, there is a fair bit of code involved so I'll limit this to a general explanation of what happens to log the code here.

LogAllCode() is the main procedure for logging code. It handles the VBA code by accessing the VBIDE (Visual Basic for Applications Integrated Development Environment) and examining each line of code referenced there. This works for standard as well as class and object (Forms / Reports) modules. As well as the VBA code there are also Macros and QueryDefs to look at.

Macros are handled by using SaveAsText() to save a text version of the macro to a file. This file is then read in and saved into the table.

QueryDefs are interesting as they cover not just those created by the designer manually but also many that are created automatically for you whenever you create any SQL in your forms or reports. The QueryDefs collection thus brings together all SQL stored in the project apart from any created on the fly using VBA code. This is very useful for finding all references. A QueryDef has a .SQL property which is queried using GetSQL() (See Access QueryDefs Mis-save Subquery SQL for why it isn't used directly). This string is then split by line and saved in the table.

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

SECTION 5 - CODE TO LOG PROPERTIES

See previous section for the first part of the module. This code follows on from that in the same module (modExtra).
Expand|Select|Wrap|Line Numbers
  1. 'LogProperties() loads (into [tblProperty]) all the Form & Report objects and
  2. '   their event properties.
  3. Public Sub LogProperties(frmProgress As Form_frmProgress _
  4.                        , Optional strPropType As String = "Event")
  5.     Dim lngDB As Long, lngGroup As Long, lngObject As Long, lngSection As Long
  6.     Dim lngX As Long
  7.     Dim strName As String
  8.     Dim blnOpen As Boolean
  9.     Dim objVar As Object
  10.     Dim aoVar As AccessObject
  11.     Dim sctVar As Section
  12.     Dim ctlVar As Control
  13.  
  14.     'Step 7.
  15.     Call frmProgress.SetStep(intStep:=7)
  16.     With appAccess.CurrentProject
  17.         Set rsVar = dbThis.OpenRecordset(Name:="tblProperty" _
  18.                                        , Type:=dbOpenDynaset _
  19.                                        , Options:=dbDenyWrite)
  20.         strName = .Name
  21.         With rsVar
  22.             Call .AddNew
  23.             !PType = "Database"
  24.             !PName = strName
  25.             lngDB = !PropID
  26.             Call .Update
  27.             Call .AddNew
  28.             !PParent = lngDB
  29.             !PType = "Group"
  30.             !PName = "Forms"
  31.             lngGroup = !PropID
  32.             Call .Update
  33.         End With
  34.         For Each aoVar In .AllForms
  35.             strName = aoVar.Name
  36.             With appAccess
  37.                 blnOpen = IsOpen(strName, acForm)
  38.                 If Not blnOpen Then _
  39.                     Call .DoCmd.OpenForm(FormName:=strName _
  40.                                        , View:=acDesign _
  41.                                        , WindowMode:=acHidden)
  42.                 Set objVar = .Forms(strName)
  43.             End With
  44.             lngObject = LoadRefs(objVar:=objVar _
  45.                                , lngParent:=lngGroup _
  46.                                , strPropType:=strPropType)
  47.             For lngX = acDetail To acPageFooter
  48.                 'Horribly kludgy interface with Sections :-(
  49.                 On Error Resume Next
  50.                 Set sctVar = Nothing
  51.                 Set sctVar = objVar.Section(lngX)
  52.                 On Error GoTo 0
  53.                 If Not sctVar Is Nothing Then
  54.                     lngSection = LoadRefs(objVar:=sctVar, lngParent:=lngObject)
  55.                     For Each ctlVar In sctVar.Controls
  56.                         Call LoadRefs(objVar:=ctlVar, lngParent:=lngSection)
  57.                     Next ctlVar
  58.                 End If
  59.             Next lngX
  60.             If Not blnOpen Then _
  61.                 Call appAccess.DoCmd.Close(ObjectType:=acForm _
  62.                                          , ObjectName:=strName _
  63.                                          , Save:=acSaveNo)
  64.         Next aoVar
  65.         With rsVar
  66.             Call .AddNew
  67.             !PParent = lngDB
  68.             !PType = "Group"
  69.             !PName = "Reports"
  70.             lngGroup = !PropID
  71.             Call .Update
  72.         End With
  73.  
  74.         'Step 8.
  75.         Call frmProgress.SetStep(intStep:=8)
  76.         For Each aoVar In .AllReports
  77.             strName = aoVar.Name
  78.             With appAccess
  79.                 blnOpen = IsOpen(strName, acReport)
  80.                 If Not blnOpen Then _
  81.                     Call .DoCmd.OpenReport(ReportName:=strName _
  82.                                          , View:=acDesign _
  83.                                          , WindowMode:=acHidden)
  84.                 Set objVar = .Reports(strName)
  85.             End With
  86.             lngObject = LoadRefs(objVar:=objVar, lngParent:=lngGroup)
  87.             For lngX = acDetail To 9999
  88.                 'Horribly kludgy interface with Sections :-(
  89.                 On Error Resume Next
  90.                 Set sctVar = Nothing
  91.                 Set sctVar = objVar.Section(lngX)
  92.                 On Error GoTo 0
  93.                 If sctVar Is Nothing Then
  94.                     If lngX > acPageFooter Then Exit For
  95.                 Else
  96.                     lngSection = LoadRefs(objVar:=sctVar, lngParent:=lngObject)
  97.                     For Each ctlVar In sctVar.Controls
  98.                         Call LoadRefs(objVar:=ctlVar, lngParent:=lngSection)
  99.                     Next ctlVar
  100.                 End If
  101.             Next lngX
  102.             If Not blnOpen Then _
  103.                 Call appAccess.DoCmd.Close(ObjectType:=acReport _
  104.                                          , ObjectName:=strName _
  105.                                          , Save:=acSaveNo)
  106.         Next aoVar
  107.         Call rsVar.Close
  108.         Set rsVar = Nothing
  109.     End With
  110. End Sub
  111.  
  112. 'LoadRefs() loads (into [tblProperty]) all the properties and sub-properties of
  113. '   the objVar.
  114. '   If strPropType is passsed then only handles properties of that type.
  115. Private Function LoadRefs(objVar As Object _
  116.                         , ByVal lngParent As Long _
  117.                         , Optional ByVal strPropType As String = "All") As Long
  118.     Static strValid As String
  119.     Dim strSQL As String, strPType As String, strPName As String
  120.     Dim prpVar As DAO.Property
  121.  
  122.     If strValid = "" Then
  123.         If strPType = "All" Then
  124.             strSQL = "lupProperty"
  125.         Else
  126.             strSQL = MultiReplace("SELECT *%L" _
  127.                                 & "FROM   [lupProperty]%L" _
  128.                                 & "WHERE  ([PType]='%T')" _
  129.                                 , "%T", strPropType _
  130.                                 , "%L", vbNewLine)
  131.         End If
  132.         strValid = ","
  133.         With dbThis.OpenRecordset(Name:=strSQL, Type:=dbOpenSnapshot)
  134.             Do Until .EOF
  135.                 strValid = strValid & !PName & ","
  136.                 Call .MoveNext
  137.             Loop
  138.             Call .Close
  139.         End With
  140.     End If
  141.     Select Case True
  142.     Case TypeOf objVar Is Form
  143.         strPType = "Form"
  144.     Case TypeOf objVar Is Report
  145.         strPType = "Report"
  146.     Case TypeOf objVar Is Section
  147.         strPType = "Section"
  148.     Case TypeOf objVar Is Control
  149.         strPType = "Control"
  150.     End Select
  151.     With rsVar
  152.         Call .AddNew
  153.         !PParent = lngParent
  154.         !PType = strPType
  155.         !PName = objVar.Name
  156.         lngParent = !PropID
  157.         Call .Update
  158.         LoadRefs = lngParent
  159.     End With
  160.     For Each prpVar In objVar.Properties
  161.         strPName = prpVar.Name
  162.         If InStr(strValid, "," & strPName & ",") > 0 Then
  163.             If prpVar.Value > "" Then
  164.                 With rsVar
  165.                     Call .AddNew
  166.                     !PParent = lngParent
  167.                     !PType = "Property"
  168.                     !PName = strPName
  169.                     !PVal = prpVar.Value
  170.                     Call .Update
  171.                 End With
  172.             End If
  173.         End If
  174.     Next prpVar
  175. End Function
  176.  
  177. 'IsOpen() returns true if strName is an open object.
  178. 'Redo using appAccess.
  179. Public Function IsOpen(strName As String, lngType As Long) As Boolean
  180.     Dim objColl As Object, objVar As Object
  181.  
  182.     With appAccess
  183.         Select Case lngType
  184.         Case acForm
  185.             Set objColl = .Forms
  186.         Case acReport
  187.             Set objColl = .Reports
  188.         End Select
  189.         For Each objVar In objColl
  190.             If strName = objVar.Name Then
  191.                 IsOpen = True
  192.                 Exit Function
  193.             End If
  194.         Next objVar
  195.     End With
  196. End Function
LogProperties() is the main procedure for logging properties. It handles object types from the main database down to the properties of a control. The code is called recursively to log the structure and displayed in qryProperty with the full hierarchy. Form and Report objects have Sections and Controls and all of these have Properties.

Properties are important as they can indicate where code and macros are invoked. If you want to identify items that are no longer used in the project, for instance, having a table of all event references can prove invaluable.

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

SECTION 6 - IMPLEMENTATION & USAGE INSTRUCTIONS

To experiment with this simply download the file, extract the databases into a folder (both together) and run RefLog.Accdb. You'll see a basic illustration of what it can do and what information is made available to you.

To utilise this functionality on your own database browse to your database file and then enter its password if it has one. Depending on the size of your project the logging process can take minutes or hours. I have a very large and complex database with many hundreds of objects and it took twenty minutes to complete. A more straightforward database of mine took a couple. However long it takes, there is a progress form which indicates whereabout you are within the process.

When all the data has been logged show the two queries from the main form. I suggest you maximise them to give optimum viewing. After that you can use standard searching and filtering to show just the lines you're interested in.

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

SECTION 7 - CODE TO OPEN DATABASE WITHOUT AUTOSTARTING ANY CODE

One very important part of this project is the OpenBypass() procedure to open a database as the CurrentDb without allowing any autostarting code to run. Equivalent to holding down the Shift or Bypass key. This is accomplished using the code below and is discussed in depth in my video Access Open Bypass (cc):

Module Name=[OpenBypass]
Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. 'Windows API Variable Prefixes
  5. 'cb = Count of Bytes (32-bit)
  6. 'w  = Word (16-bit)
  7. 'dw = Double Word (32-bit)
  8. 'lp = Long Pointer (32-bit)
  9. 'b  = Boolean (32-bit)
  10. 'h  = Handle (32-bit)
  11. 'ul = Unsigned Long (32-bit)
  12.  
  13. Private Const conShift As Integer = &H10
  14.  
  15. Private Declare Function GetKeyboardState Lib "user32" _
  16.                             (ByRef abytKeys As Byte) As Long
  17. Private Declare Function SetKeyboardState Lib "user32" _
  18.                             (ByRef abytKeys As Byte) As Long
  19. Private Declare Function SetForegroundWindow Lib "user32" _
  20.                             (ByVal lngWnd As Long) As Long
  21. Private Declare Function SetFocus Lib "user32" _
  22.                             (ByVal lngWnd As Long) As Long
  23. Private Declare Function GetWindowThreadProcessId Lib "user32" _
  24.                             (ByVal lngWnd As Long _
  25.                            , ByRef lngProcessId As Long) As Long
  26. Private Declare Function AttachThreadInput Lib "user32" _
  27.                             (ByVal lngIDAttach As Long _
  28.                            , ByVal lngIDAttachTo As Long _
  29.                            , ByVal lngAttach As Long) As Long
  30.  
  31. 'OpenBypass() creates a new instance of Access and opens strDB (using strPW
  32. '   if passed) without any auto-start features triggered (AutoExec macro or
  33. '   Startup form/page).
  34. '   It returns the new Access application.
  35. Public Function OpenBypass(ByVal strDB As String _
  36.                          , Optional blnExclusive As Boolean = False _
  37.                          , Optional strPW As String = "") _
  38.                            As Access.Application
  39.     Dim lngThis As Long, lngThat As Long
  40.     Dim abytKeys(0 To 255) As Byte, bytVar As Byte
  41.  
  42.     ' Create new automation instance of Access
  43.     Set OpenBypass = CreateObject("Access.Application")
  44.     With OpenBypass
  45.         .Visible = True
  46.         ' Attach to process
  47.         lngThis = GetWindowThreadProcessId(hWndAccessApp, ByVal 0)
  48.         lngThat = GetWindowThreadProcessId(.hWndAccessApp, ByVal 0)
  49.         Call AttachThreadInput(lngThis, lngThat, True)
  50.         ' First give new application focus
  51.         Call SetForegroundWindow(.hWndAccessApp)
  52.         Call SetFocus(.hWndAccessApp)
  53.         ' Set Shift state
  54.         Call GetKeyboardState(abytKeys(0))
  55.         bytVar = abytKeys(conShift)
  56.         abytKeys(conShift) = &H80
  57.         Call SetKeyboardState(abytKeys(0))
  58.         ' Open strDB with auto-start features disabled
  59.         Call .OpenCurrentDatabase(Filepath:=strDB _
  60.                                 , Exclusive:=blnExclusive _
  61.                                 , bstrPassword:=strPW)
  62.         ' Revert keyboard state
  63.         abytKeys(conShift) = bytVar
  64.         Call SetKeyboardState(abytKeys(0))
  65.         ' Detach threads
  66.         Call AttachThreadInput(lngThis, lngThat, False)
  67.     End With
  68. End Function
--------------------------------------------------------------------------------
Attached Files
File Type: zip RefLog.Zip (135.4 KB, 559 views)
Jul 13 '14 #1
Share this Article
Share on Google+
5 Comments


Expert 100+
P: 1,219
This will be very useful, both for its functionality and also as a reference for how to code some things. I've never cruised through the VBA code before.

Thanks!

Jim
Aug 16 '14 #2

NeoPa
Expert Mod 15k+
P: 31,084
This article has now been revised with a new version (attached to OP in place of the original) which :
  1. Runs as a separate project. No longer needs to be integrated into an existing one.
  2. Handles DB passwords for the DB to be loaded.
  3. Shows a progress window while the logging is in progress.
  4. Handles bypassing the automatic startup options of the DB being logged.

I strongly recommend downloading the new version even if you have a copy of the old.
Aug 19 '14 #3

twinnyfo
Expert Mod 2.5K+
P: 2,667
NeoPa,

This will be incredibly helpful to me! Not only for those minor changes that affect my entire DB, but also to assist in documentation. I, too, have suffered the effects of Access loosing data in its documenter!

Thanks for this awesome tool!
Aug 19 '14 #4

NeoPa
Expert Mod 15k+
P: 31,084
Hi Twinnyfo.

If you're interested in documentation then one of our members here (and a friend of mine - strive4peace) has knocked something up recently I believe you may be interested in -
Crystal's Code Documenter.
Aug 21 '14 #5

NeoPa
Expert Mod 15k+
P: 31,084
Updated to include the OpenBypass() code to coincide with the video I just published explaining how that works - Access Open Bypass (cc).

Many thanks are due, again, to Crystal (strive4peace). An Access MVP of very long standing and a friend.
Oct 5 '14 #6