vba 将 MS Access 表单和类/模块递归导出到文本文件？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16948215/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Exporting MS Access Forms and Class / Modules Recursively to text files?
提问by leeand00
I found some code on an ancient message board that nicely exports all of the VBA code from classes, modules and forms (see below):
我在一个古老的留言板上发现了一些代码，可以很好地从类、模块和表单中导出所有 VBA 代码（见下文）：
Option Explicit
Option Compare Database
Function SaveToFile() 'Save the code for all modules to files in currentDatabaseDir\Code
Dim Name As String
Dim WasOpen As Boolean
Dim Last As Integer
Dim I As Integer
Dim TopDir As String, Path As String, FileName As String
Dim F As Long 'File for saving code
Dim LineCount As Long 'Line count of current module
I = InStrRev(CurrentDb.Name, "\")
TopDir = VBA.Left(CurrentDb.Name, I - 1)
Path = TopDir & "\" & "Code" 'Path where the files will be written
If (Dir(Path, vbDirectory) = "") Then
MkDir Path 'Ensure this exists
End If
'--- SAVE THE STANDARD MODULES CODE ---
Last = Application.CurrentProject.AllModules.Count - 1
For I = 0 To Last
Name = CurrentProject.AllModules(I).Name
WasOpen = True 'Assume already open
If Not CurrentProject.AllModules(I).IsLoaded Then
WasOpen = False 'Not currently open
DoCmd.OpenModule Name 'So open it
End If
LineCount = Access.Modules(Name).CountOfLines
FileName = Path & "\" & Name & ".vba"
If (Dir(FileName) <> "") Then
Kill FileName 'Delete previous version
End If
'Save current version
F = FreeFile
Open FileName For Output Access Write As #F
Print #F, Access.Modules(Name).Lines(1, LineCount)
Close #F
If Not WasOpen Then
DoCmd.Close acModule, Name 'It wasn't open, so close it again
End If
Next
'--- SAVE FORMS MODULES CODE ---
Last = Application.CurrentProject.AllForms.Count - 1
For I = 0 To Last
Name = CurrentProject.AllForms(I).Name
WasOpen = True
If Not CurrentProject.AllForms(I).IsLoaded Then
WasOpen = False
DoCmd.OpenForm Name, acDesign
End If
LineCount = Access.Forms(Name).Module.CountOfLines
FileName = Path & "\" & Name & ".vba"
If (Dir(FileName) <> "") Then
Kill FileName
End If
F = FreeFile
Open FileName For Output Access Write As #F
Print #F, Access.Forms(Name).Module.Lines(1, LineCount)
Close #F
If Not WasOpen Then
DoCmd.Close acForm, Name
End If
Next
MsgBox "Created source files in " & Path
End Function
However, this code does not solve my problem since I have 110 ms-access *.mdb's that I need to export the vba from into text files suitable for grepping.
但是，这段代码并没有解决我的问题，因为我有 110 ms-access*.mdb需要将 vba 从中导出到适合 grepping 的文本文件中。
The paths to the 110 files I'm interested in are already stored in a table, and my code already gained this information recursively (along with some other filtering)...so the recursive part is done.
我感兴趣的 110 个文件的路径已经存储在一个表中，我的代码已经以递归方式获得了这些信息（以及其他一些过滤）......所以递归部分完成了。
Most of these files are opened by a single access user security file, an .mdwand I have tried several methods of opening them. ADO and ADOX worked great when I was searching for linked tables in these directories...but the code above involves being inside the database you are exporting the data from, and I want to be able to do this from a separate database that opens all of the mdbs and performs the export on each of them.
大多数这些文件是由单一访问用户安全文件打开的.mdw，我尝试了几种打开它们的方法。当我在这些目录中搜索链接表时，ADO 和 ADOX 工作得很好……但是上面的代码涉及到您要从中导出数据的数据库中，我希望能够从一个单独的数据库中执行此操作，该数据库打开所有的mdbS和对每个它们的出口。
One of my attempts at this involved using the PrivDBEngine class to connect to the databases externally, but it doesn't allow me to access the Application object which is what the export code above requires.
我在这方面的尝试之一涉及使用 PrivDBEngine 类从外部连接到数据库，但它不允许我访问上面的导出代码所需的 Application 对象。
Private Sub exportToFile(db_path As String, db_id As String, loginInfo As AuthInfoz, errFile As Variant)
Dim pdbeNew As PrivDBEngine
Dim db As DAO.Database
Dim ws As DAO.Workspace
Dim rst As DAO.Recordset
Dim cn As ADODB.Connection ' ADODB.Connection
Dim rs As ADODB.Recordset ' ADODB.Recordset
Dim strConnect As String
Dim blnReturn As Boolean
Dim Doc As Document
Dim mdl As Module
Dim lngCount As Long
Dim strForm As String
Dim strOneLine As String
Dim sPtr As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
Set exportFile = fso.CreateTextFile("E:\Tickets\CSN1006218\vbacode\" & db_id & ".txt", ForAppending)
' Export stuff...
On Error GoTo errorOut
Set pdbeNew = New PrivDBEngine
With pdbeNew
.SystemDB = loginInfo.workgroup
.DefaultUser = loginInfo.username
.DefaultPassword = loginInfo.password
End With
Set ws = pdbeNew.Workspaces(0)
Set db = ws.OpenDatabase(db_path)
For Each Doc In db.Containers("Modules").Documents
DoCmd.OpenModule Doc.Name
Set mdl = Modules(Doc.Name)
exportFile.WriteLine ("---------------------")
exportFile.WriteLine ("Module Name: " & Doc.Name)
exportFile.WriteLine ("Module Type: " & mdl.Type)
exportFile.WriteLine ("---------------------")
lngCount = lngCount + mdl.CountOfLines
'For i = 1 To lngCount
' strOneLine = mdl.Lines(i, 1)
' exportFile.WriteLine (strOneLine)
'Next i
Set mdl = Nothing
DoCmd.Close acModule, Doc.Name
Next Doc
Close_n_exit:
If Not (db Is Nothing) Then
Call wk.Close
Set wk = Nothing
Call db.Close
End If
Call exportFile.Close
Set exportFile = Nothing
Set fso = Nothing
Exit Sub
errorOut:
Debug.Print "----------------"
Debug.Print "BEGIN: Err"
If err.Number <> 0 Then
Msg = "Error # " & Str(err.Number) & " was generated by " _
& err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & err.Description
'MsgBox Msg, , "Error", err.HelpFile, err.HelpContext
Debug.Print Msg
End If
Resume Close_n_exit
End Sub
Is there anyway to access the applicationobject from a PrivDBEngine? I have alot of modules that need grepping.
无论如何可以application从 a访问对象PrivDBEngine吗？我有很多需要 grepping 的模块。
回答by ??c Thanh Nguy?n
You can also try this code. It will preserve the items' filetypes (.bas, .cls, .frm) Remember to refer to / Check the Microsoft Visual Basic For Applications Extensibility Libraryin VBE > Tools > References
你也可以试试这个代码。它将保留项目的文件类型（.bas、.cls、.frm）记得在 VBE > Tools > References 中参考/检查Microsoft Visual Basic For Applications Extensibility Library
Public Sub ExportAllCode()
Dim c As VBComponent
Dim Sfx As String
For Each c In Application.VBE.VBProjects(1).VBComponents
Select Case c.Type
Case vbext_ct_ClassModule, vbext_ct_Document
Sfx = ".cls"
Case vbext_ct_MSForm
Sfx = ".frm"
Case vbext_ct_StdModule
Sfx = ".bas"
Case Else
Sfx = ""
End Select
If Sfx <> "" Then
c.Export _
Filename:=CurrentProject.Path & "\" & _
c.Name & Sfx
End If
Next c
End Sub
回答by Clon
You can use the Access.Application object.
您可以使用 Access.Application 对象。
Also, in order to avoid multiple confirmation dialogs when opening the databases, just change the security level in Tools / Macros / Security.
另外，为了避免在打开数据库时出现多个确认对话框，只需在工具/宏/安全中更改安全级别即可。
And to open multiple databases with user/password you can join the workgroup (Tools / Security / Workgroup administrator) and log in with the desired user/password (from the database with the SaveToFile function), then run the code. Remember, later on, to join the default workgroup (you can try to join an inexistent workgroup and access will revert to the default).
并且要使用用户/密码打开多个数据库，您可以加入工作组（工具/安全/工作组管理员）并使用所需的用户/密码登录（从具有 SaveToFile 功能的数据库），然后运行代码。请记住，稍后要加入默认工作组（您可以尝试加入不存在的工作组，访问权限将恢复为默认值）。
Option Explicit
Option Compare Database
'Save the code for all modules to files in currentDatabaseDir\Code
Public Function SaveToFile()
On Error GoTo SaveToFile_Err
Dim Name As String
Dim WasOpen As Boolean
Dim Last As Integer
Dim i As Integer
Dim TopDir As String, Path As String, FileName As String
Dim F As Long 'File for saving code
Dim LineCount As Long 'Line count of current module
Dim oApp As New Access.Application
' Open remote database
oApp.OpenCurrentDatabase ("D:\Access\myDatabase.mdb"), False
i = InStrRev(oApp.CurrentDb.Name, "\")
TopDir = VBA.Left(oApp.CurrentDb.Name, i - 1)
Path = TopDir & "\" & "Code" 'Path where the files will be written
If (Dir(Path, vbDirectory) = "") Then
MkDir Path 'Ensure this exists
End If
'--- SAVE THE STANDARD MODULES CODE ---
Last = oApp.CurrentProject.AllModules.Count - 1
For i = 0 To Last
Name = oApp.CurrentProject.AllModules(i).Name
WasOpen = True 'Assume already open
If Not oApp.CurrentProject.AllModules(i).IsLoaded Then
WasOpen = False 'Not currently open
oApp.DoCmd.OpenModule Name 'So open it
End If
LineCount = oApp.Modules(Name).CountOfLines
FileName = Path & "\" & Name & ".vba"
If (Dir(FileName) <> "") Then
Kill FileName 'Delete previous version
End If
'Save current version
F = FreeFile
Open FileName For Output Access Write As #F
Print #F, oApp.Modules(Name).Lines(1, LineCount)
Close #F
If Not WasOpen Then
oApp.DoCmd.Close acModule, Name 'It wasn't open, so close it again
End If
Next
'--- SAVE FORMS MODULES CODE ---
Last = oApp.CurrentProject.AllForms.Count - 1
For i = 0 To Last
Name = oApp.CurrentProject.AllForms(i).Name
WasOpen = True
If Not oApp.CurrentProject.AllForms(i).IsLoaded Then
WasOpen = False
oApp.DoCmd.OpenForm Name, acDesign
End If
LineCount = oApp.Forms(Name).Module.CountOfLines
FileName = Path & "\" & Name & ".vba"
If (Dir(FileName) <> "") Then
Kill FileName
End If
F = FreeFile
Open FileName For Output Access Write As #F
Print #F, oApp.Forms(Name).Module.Lines(1, LineCount)
Close #F
If Not WasOpen Then
oApp.DoCmd.Close acForm, Name
End If
Next
'--- SAVE REPORTS MODULES CODE ---
Last = oApp.CurrentProject.AllReports.Count - 1
For i = 0 To Last
Name = oApp.CurrentProject.AllReports(i).Name
WasOpen = True
If Not oApp.CurrentProject.AllReports(i).IsLoaded Then
WasOpen = False
oApp.DoCmd.OpenReport Name, acDesign
End If
LineCount = oApp.Reports(Name).Module.CountOfLines
FileName = Path & "\" & Name & ".vba"
If (Dir(FileName) <> "") Then
Kill FileName
End If
F = FreeFile
Open FileName For Output Access Write As #F
Print #F, oApp.Reports(Name).Module.Lines(1, LineCount)
Close #F
If Not WasOpen Then
oApp.DoCmd.Close acReport, Name
End If
Next
MsgBox "Created source files in " & Path
' Reset the security level
Application.AutomationSecurity = msoAutomationSecurityByUI
SaveToFile_Exit:
If Not oApp.CurrentDb Is Nothing Then oApp.CloseCurrentDatabase
If Not oApp Is Nothing Then Set oApp = Nothing
Exit function
SaveToFile_Err:
MsgBox ("Error " & Err.Number & vbCrLf & Err.Description)
Resume SaveToFile_Exit
End Function
I have added code for the Reports modules. When I get some time I'll try to refactor the code.
我为报告模块添加了代码。当我有时间时，我会尝试重构代码。
I find this a great contribution. Thanks for sharing.
我觉得这是一个很大的贡献。感谢分享。
Regards
问候
================= EDIT ==================
================ 编辑 ==================
After a while I found the way to export the whole database (tables and queries included) and have been using it for version control in Git.
一段时间后，我找到了导出整个数据库（包括表和查询）的方法，并一直在使用它在 Git 中进行版本控制。
Of course, if you have really big tables what you really want is a backup. This I use with the tables in its initial state, many of them empty, for development purposes only.
当然，如果您有非常大的表，您真正想要的是备份。我将它与处于初始状态的表一起使用，其中许多是空的，仅用于开发目的。
Option Compare Database
Option Explicit
Private Const VB_MODULE As Integer = 1
Private Const VB_CLASS As Integer = 2
Private Const VB_FORM As Integer = 100
Private Const EXT_TABLE As String = ".tbl"
Private Const EXT_QUERY As String = ".qry"
Private Const EXT_MODULE As String = ".bas"
Private Const EXT_CLASS As String = ".cls"
Private Const EXT_FORM As String = ".frm"
Private Const CODE_FLD As String = "code"
Private Const mblnSave As Boolean = True ' False: just generate the script
'
'
Public Sub saveAllAsText()
Dim oTable As TableDef
Dim oQuery As QueryDef
Dim oCont As Container
Dim oForm As Document
Dim oModule As Object
Dim FSO As Object
Dim strPath As String
Dim strName As String
Dim strFileName As String
'**
On Error GoTo errHandler
strPath = CurrentProject.path
Set FSO = CreateObject("Scripting.FileSystemObject")
strPath = addFolder(FSO, strPath, Application.CurrentProject.name & "_" & CODE_FLD)
strPath = addFolder(FSO, strPath, Format(Date, "yyyy.mm.dd"))
For Each oTable In CurrentDb.TableDefs
strName = oTable.name
If left(strName, 4) <> "MSys" Then
strFileName = strPath & "\" & strName & EXT_TABLE
If mblnSave Then Application.ExportXML acExportTable, strName, strFileName, strFileName & ".XSD", strFileName & ".XSL", , acUTF8, acEmbedSchema + acExportAllTableAndFieldProperties
Debug.Print "Application.ImportXML """ & strFileName & """, acStructureAndData"
End If
Next
For Each oQuery In CurrentDb.QueryDefs
strName = oQuery.name
If left(strName, 1) <> "~" Then
strFileName = strPath & "\" & strName & EXT_QUERY
If mblnSave Then Application.SaveAsText acQuery, strName, strFileName
Debug.Print "Application.LoadFromText acQuery, """ & strName & """, """ & strFileName & """"
End If
Next
Set oCont = CurrentDb.Containers("Forms")
For Each oForm In oCont.Documents
strName = oForm.name
strFileName = strPath & "\" & strName & EXT_FORM
If mblnSave Then Application.SaveAsText acForm, strName, strFileName
Debug.Print "Application.LoadFromText acForm, """ & strName & """, """ & strFileName & """"
Next
strPath = addFolder(FSO, strPath, "modules")
For Each oModule In Application.VBE.ActiveVBProject.VBComponents
strName = oModule.name
strFileName = strPath & "\" & strName
Select Case oModule.Type
Case VB_MODULE
If mblnSave Then oModule.Export strFileName & EXT_MODULE
Debug.Print "Application.VBE.ActiveVBProject.VBComponents.Import """ & strFileName & EXT_MODULE; """"
Case VB_CLASS
If mblnSave Then oModule.Export strFileName & EXT_CLASS
Debug.Print "Application.VBE.ActiveVBProject.VBComponents.Import """ & strFileName & EXT_CLASS; """"
Case VB_FORM
' Do not export form modules (already exported the complete forms)
Case Else
Debug.Print "Unknown module type: " & oModule.Type, oModule.name
End Select
Next
If mblnSave Then MsgBox "Files saved in " & strPath, vbOKOnly, "Export Complete"
Exit Sub
errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf
Stop: Resume
End Sub
'
'
' Create a folder when necessary. Append the folder name to the given path.
'
Private Function addFolder(ByRef FSO As Object, ByVal strPath As String, ByVal strAdd As String) As String
addFolder = strPath & "\" & strAdd
If Not FSO.FolderExists(addFolder) Then MkDir addFolder
End Function
'
回答by sebastian
Like for MS Excel, you can also use a loop over the Application.VBE.VBProjects(1).VBComponentsand use the Exportmethod to export your modules/classes/forms:
与 MS Excel 一样，您也可以在 上使用循环Application.VBE.VBProjects(1).VBComponents并使用该Export方法导出您的模块/类/表单：
Const VB_MODULE = 1
Const VB_CLASS = 2
Const VB_FORM = 100
Const EXT_MODULE = ".bas"
Const EXT_CLASS = ".cls"
Const EXT_FORM = ".frm"
Const CODE_FLD = "Code"
Sub ExportAllCode()
Dim fileName As String
Dim exportPath As String
Dim ext As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
' Set export path and ensure its existence
exportPath = CurrentProject.path & "\" & CODE_FLD
If Not FSO.FolderExists(exportPath) Then
MkDir exportPath
End If
' The loop over all modules/classes/forms
For Each c In Application.VBE.VBProjects(1).VBComponents
' Get the filename extension from type
ext = vbExtFromType(c.Type)
If ext <> "" Then
fileName = c.name & ext
debugPrint "Exporting " & c.name & " to file " & fileName
' THE export
c.Export exportPath & "\" & fileName
Else
debugPrint "Unknown VBComponent type: " & c.Type
End If
Next c
End Sub
' Helper function that translates VBComponent types into file extensions
' Returns an empty string for unknown types
Function vbExtFromType(ByVal ctype As Integer) As String
Select Case ctype
Case VB_MODULE
vbExtFromType = EXT_MODULE
Case VB_CLASS
vbExtFromType = EXT_CLASS
Case VB_FORM
vbExtFromType = EXT_FORM
End Select
End Function
Only takes a fraction of a second to execute.
执行只需几分之一秒。
Cheers
干杯
回答by Doug Coats
IDK why no one has suggested this before, but here is a small piece of code I use for this. Pretty simple and straightforward
IDK 为什么以前没有人提出过这个建议，但这是我为此使用的一小段代码。非常简单明了
Public Sub VBAExportModule()
On Error GoTo Errg
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT MSysObjects.Name FROM MSysObjects WHERE Type=-32761", dbOpenDynaset, dbSeeChanges)
Do Until rs.EOF
Application.SaveAsText acModule, rs("Name"), "C:\" & rs("Name") & ".txt"
rs.MoveNext
Loop
Cleanup:
If Not rs Is Nothing Then rs.Close
Set rs = Nothing
Exit Sub
Errg:
GoTo Cleanup
End Sub
回答by dmc2005
Lovely answer Clon.
可爱的回答克隆。
Just a slight variation if you are trying to open MDBs that has a startup formand/or a AutoExec macroand above doesn't always seem to work reliably.
如果您尝试打开具有启动表单和/或AutoExec 宏及更高版本的MDB，只需稍作改动似乎并不总是可靠地工作。
Looking at this answer on another website: By pass startup form / macrosand scrolling almost to the end of the discussion is some code which temporarily gets rid of the startup form settings and extracts the AutoExec macro to your database before writing over it with an TempAutoExec macro (which does nothing), does some work (between lines 'Read command barsand app.CloseCurrentDatabase) and then fixes everything back again.
在另一个网站上查看此答案：通过启动表单/宏并几乎滚动到讨论的结尾是一些代码，这些代码暂时摆脱了启动表单设置并将 AutoExec 宏提取到您的数据库中，然后再使用 TempAutoExec宏（什么都不做），做了一些工作（在“读取命令栏”和app.CloseCurrentDatabase行之间），然后再次修复所有内容。
回答by MartiniB
another way is keep most used code in one external master.mdb and join it to any count of *.mdbs trough Modules->Tools->References->Browse->...\master.mdb
另一种方法是将最常用的代码保存在一个外部 master.mdb 中，并通过 Modules->Tools->References->Browse->...\master.mdb 将其加入任何数量的 *.mdbs
the only problem in old 97 Access you can Debug, Edit and Save directly in destination.mdb, but in all newer, since MA 2000, 'Save' option is gone and any warnings on close unsaved code
旧的 97 Access 中唯一的问题是您可以直接在 destination.mdb 中调试、编辑和保存，但在所有更新的版本中，自 MA 2000 以来，“保存”选项消失了，并且关闭未保存的代码时会出现任何警告
