Excel や Acces で作成された、いわゆるVBAツールは、要件定義書、仕様書、設計書、マニュアル等のドキュメント類が「何それ?美味しいの?」状態の場合が多い。
とにかく、テーブル(およびそのフィールド)名、フォーム(およびその部品(コントロール))名、クエリ、プロシージャなどの一覧リストをテキスト出力しておくこと。
それらをExcelのシートなどに貼り付けて全体のおおまかな仕様を管理しやすくすることが大事。
Access_Name_Module.bas
' <参照設定>
' [Microsoft Visual Basic for Applications Extensibility]
Option Compare Database
Option Explicit
'// 与えられた文字列(tgt_str)を、半角スペースパディングした n_byte バイトの固定長文字列にして返す
Function FixedStrB(ByVal tgt_str As String, ByVal n_byte As Long) As String
FixedStrB = StrConv(LeftB(StrConv(tgt_str & Space(n_byte), vbFromUnicode), n_byte), vbUnicode)
End Function
'// テーブル名一覧を返す
Function GetTableList()
Dim tdf As TableDef
Dim tdfName As String
Dim tblList As String
Dim n As Long
For Each tdf In CurrentDb.TableDefs
tdfName = tdf.Name
If Left(tdfName, 4) <> "MSys" Then
n = n + 1
Debug.Print Format(n, "@@@@"); " |"; tdfName
tblList = tblList & vbCrLf & tdfName
End If
Next tdf
GetTableList = tblList
End Function
'// フォーム名一覧を返す
Function GetFormList()
Dim frm
Dim frmList As String
Dim n As Long
For Each frm In CurrentProject.AllForms
n = n + 1
Debug.Print Format(n, "@@@@"); " |"; frm.Name
frmList = frmList & vbCrLf & frm.Name
Next frm
GetFormList = frmList
End Function
'// クエリ名一覧を返す
Function GetQueryList()
Dim qry As QueryDef
Dim qryName As String
Dim qryList As String
Dim n As Long
For Each qry In CurrentDb.QueryDefs
qryName = qry.Name
If Left(qryName, 4) <> "~sq_" Then
n = n + 1
Debug.Print Format(n, "@@@@"); " |"; qryName
qryList = qryList & vbCrLf & qry.Name
End If
Next qry
GetQueryList = qryList
End Function
'// レポート一覧を返す
Function GetReportList()
Dim rprt
Dim rprtList As String
Dim n As Long
For Each rprt In CurrentProject.AllReports
n = n + 1
Debug.Print Format(n, "@@@@"); " |"; rprt.Name
rprtList = rprtList & vbCrLf & rprt.Name
Next rprt
GetReportList = rprtList
End Function
'// テーブル(table_name)のフィールド名一覧を返す
Function GetFieldNameList(ByVal table_name As String)
Dim db As DAO.Database: Set db = CurrentDb
Dim fld As DAO.Field
Dim fldNameList As String
Dim n As Long
For Each fld In db.TableDefs(table_name).Fields
Debug.Print Format(n, "@@@@"); " |"; fld.Name
fldNameList = fldNameList & fld.Name & vbCrLf
Next fld
Set db = Nothing
GetFieldNameList = fldNameList
End Function
'// フォーム(form_name)に配置されているコントロール名一覧を返す
Function GetControlNameList(ByVal form_name As String)
Dim ctrl As Control
Dim ctrlNameList As String
Dim n As Long
For Each ctrl In Forms(form_name).Controls
n = n + 1
Debug.Print Format(n, "@@@@"); " |"; _
ctrl.ControlType; " |"; _
FixedStrB(TypeName(ctrl), 15); " |"; _
ctrl.Name
ctrlNameList = ctrlNameList & ctrl.Name & vbCrLf
Next ctrl
GetControlNameList = ctrlNameList
End Function
'// モジュール一覧を返す
Function GetModuleList()
Dim mdl
Dim mdlList As String
Dim n As Long
For Each mdl In CurrentProject.AllModules
n = n + 1
Debug.Print Format(n, "@@@@"); " |"; mdl.Name
mdlList = mdlList & mdl.Name & vbCrLf
Next mdl
GetModuleList = mdlList
End Function
'// フォームモジュール名一覧を返す
Function GetFormModulesList()
Dim vbComp As VBComponent
Dim frmMdlList As String
Dim n As Long
For Each vbComp In Application.VBE.ActiveVBProject.VBComponents
If vbComp.Type = vbext_ct_Document Then
n = n + 1
Debug.Print Format(n, "@@@@"); " |"; _
FixedStrB(vbComp.Name, 20); " |"; _
vbComp.Type
frmMdlList = frmMdlList & vbComp.Name & vbCrLf
End If
Next
GetFormModulesList = frmMdlList
End Function
'// プロシージャの一覧を返す
Function GetProcedureList()
Dim vbComp As VBComponent
Dim codeMod As CodeModule
Dim procKind As vbext_ProcKind
Dim procName As String
Dim procList As String
Dim lineNum As Long
Dim n As Long
Debug.Print FixedStrB("No.", 4); " |"; _
FixedStrB("モジュール名", 20); " |"; _
"プロシージャ名"
For Each vbComp In Application.VBE.ActiveVBProject.VBComponents
Set codeMod = vbComp.CodeModule
lineNum = 1
Do While lineNum < codeMod.CountOfLines
procName = codeMod.ProcOfLine(lineNum, procKind)
If procName <> "" Then
n = n + 1
Debug.Print Format(n, "@@@@"); " |"; _
FixedStrB(vbComp.Name, 20); " |"; _
procName
procList = procList & vbCrLf & vbComp.Name & "." & procName
lineNum = lineNum + codeMod.ProcCountLines(procName, procKind)
Else
lineNum = lineNum + 1
End If
Loop
Next vbComp
Set codeMod = Nothing
GetProcedureList = procList
End Function