从 Microsoft Access 导出代码

Posted 2023-04-19

技术标签:

【中文标题】从 Microsoft Access 导出代码【英文标题】：exporting code from Microsoft Access 【发布时间】：2010-05-08 14:49:05 【问题描述】：

有没有办法将 Microsoft Access 代码批量导出到文件中？我知道我可以一次导出一个文件，但是有数百个，我会整天在这里。是否没有“全部导出”或多选导出？

【问题讨论】：

为什么只想要代码？我想使用 grep 和其他文本工具来查找模式和死代码。我不是访问开发人员，也不习惯这种原始工具。我觉得你将 Access 称为“原始”然后使用 grep 会很有趣，根据定义，它是一种围绕 UNIX 哲学设计的工具，即创建小型甚至“原始”程序一件事很好，然后可以链接在一起以执行复杂的操作。如果您能告诉我如何找到对查询、调用层次结构、函数等的所有引用，那么我就不必这样做了。我并不是说 grep 是新事物——只是 Access 没有给我 VS 或 Eclipse 的工具。您想在代码中查找单个字符串？在 Access 中做到这一点并不难。但是如果你真的想知道函数在哪里使用，你不能只搜索代码，因为它可以用作表单或报表中的表达式，由宏中的 RunCode 调用，用作操作用于工具栏/菜单，甚至用于 Switchboard 表。通过限制自己对代码执行 grep，您将无法知道自己是否收到了正确的答案。甚至所有对象上的 SaveAsText 也不会这样做，因为其中一些对象不能以这种方式导出。 【参考方案1】：

您无需编写任何代码就可以做到这一点。从菜单中选择工具->分析->数据库记录器。

这将为您提供一系列打印代码的选项。然后，您可以在查看报告时将其发送到您的 PDF 打印机（如果您有的话）。或者，只需打印到文本文件打印机。或者你甚至可以点击报告菜单栏中的word选项，结果将发送到word

数据库记录器可以打印所有代码，包括表单中的代码。

因此，您可以代替一些建议的代码示例，而无需编写任何代码。使用文档器中的其他选项。记录器将为数据库中的每个属性和对象生成大量打印信息。因此，如果您不取消选中某些选项，那么您将轻松清空全尺寸打印机托盘。因此，此文档记录器会产生大量打印输出。

【讨论】：

【参考方案2】：

要将所有代码（包括来自表单和报表的代码）输出到桌面，您可以将其粘贴到标准模块中，然后按 F5 或按 F8 单步执行。您不妨先填写桌面文件夹的名称。

   Sub AllCodeToDesktop()
   ''The reference for the FileSystemObject Object is Windows Script Host Object Model
   ''but it not necessary to add the reference for this procedure.

   Dim fs As Object
   Dim f As Object
   Dim strMod As String
   Dim mdl As Object
   Dim i As Integer

   Set fs = CreateObject("Scripting.FileSystemObject")

   ''Set up the file.
   ''SpFolder is a small function, but it would be better to fill in a
   ''path name instead of SpFolder(Desktop), eg "c:\users\somename\desktop"
   Set f = fs.CreateTextFile(SpFolder(Desktop) & "\" _
       & Replace(CurrentProject.Name, ".", "") & ".txt")

   ''For each component in the project ...
   For Each mdl In VBE.ActiveVBProject.VBComponents
       ''using the count of lines ...
       i = VBE.ActiveVBProject.VBComponents(mdl.Name).CodeModule.CountOfLines
       ''put the code in a string ...
       If i > 0 Then
          strMod = VBE.ActiveVBProject.VBComponents(mdl.Name).codemodule.Lines(1, i)
       End If
       ''and then write it to a file, first marking the start with
       ''some equal signs and the component name.
       f.writeline String(15, "=") & vbCrLf & mdl.Name _
           & vbCrLf & String(15, "=") & vbCrLf & strMod
   Next

   ''Close eveything
   f.Close
   Set fs = Nothing
   End Sub

要获取特殊文件夹，可以使用微软提供的列表。

枚举特殊文件夹：http://www.microsoft.com/technet/scriptcenter/guide/sas_fil_higv.mspx?mfr=true

发件人：http://wiki.lessthandot.com/index.php/Code_and_Code_Windows

【讨论】：

这个答案对我来说效果最好，即使有一些语法问题。我能够获得进行 grep 所需的文本。【参考方案3】：

界面中没有任何内容可以一次导出多个模块。

您可以轻松编写自己的“全部导出”等效代码：

Public Sub ExportModules()
Const cstrExtension As String = ".bas"
Dim objModule As Object
Dim strFolder As String
Dim strDestination As String

strFolder = CurrentProject.Path

For Each objModule In CurrentProject.AllModules
    strDestination = strFolder & Chr(92) & objModule.Name & cstrExtension
    Application.SaveAsText acModule, objModule.Name, strDestination
Next objModule
End Sub

【讨论】：

我该如何运行它？我不是访问者......对不起仅适用于模块代码 - 我如何获取表单和报告？ @articpenguin 我不知道这是否足以满足您的需求，但我想我会试一试。您可以将 undocument SaveAsText 方法用于其他数据库对象，例如表单和报表。您可以在 Patrick 给您的链接中找到更多详细信息。我使用了我提供的方法，通过表单上命令按钮的单击事件调用它。 @articpenguin 我在另一篇文章中添加了关于使用 VBE 的说明。 @HansUp SaveAsText 将为您提供一切，包括控件。【参考方案4】：

这是我的版本：

'============================================================'
' OutputCodeModules for Access
' Don Jewett, verion 2014.11.10
' Exports the following items from an Access database
'   Modules
'   Form Modules
'   Report Modules
'
' Must be imported into Access database and run from there
'============================================================'
Option Explicit
Option Compare Database

Private Const KEY_MODULES As String = "Modules"
Private Const KEY_FORMS As String = "Forms"
Private Const KEY_REPORTS As String = "Reports"

Private m_bCancel As Boolean
Private m_sLogPath As String

'------------------------------------------------------------'
' >>>>>> Run this using F5 or F8 <<<<<<<<
'------------------------------------------------------------'
Public Sub OutputModuleHelper()
    OutputModules
End Sub

Public Sub OutputModules(Optional ByVal sFolder As String)
    Dim nCount As Long
    Dim nSuccessful As Long
    Dim sLine As String
    Dim sMessage As String
    Dim sFile As String

    If sFolder = "" Then
        sFolder = Left$(CurrentDb.Name, InStrRev(CurrentDb.Name, "\") - 1)
        sFolder = InputBox("Enter folder for files", "Output Code", sFolder)
        If sFolder = "" Then
            Exit Sub
        End If
    End If

    'normalize root path by removing trailing back-slash
    If Right(sFolder, 1) = "\" Then
        sFolder = Left(sFolder, Len(sFolder) - 1)
    End If

    'make sure this folder exists
    If Not isDir(sFolder) Then
        MsgBox "Folder does not exist", vbExclamation Or vbOKOnly
        Exit Sub
    End If

    'get a new log filename
    m_sLogPath = sFolder & "\_log-" & Format(Date, "yyyy-MM-dd-nn-mm-ss") & ".txt"

    sLine = CurrentDb.Name
    writeLog sLine
    sMessage = sLine & vbCrLf

    sLine = Format(Now, "yyyy-MM-dd nn:mm:ss") & vbCrLf
    writeLog sLine
    sMessage = sMessage & sLine & vbCrLf

    'output modules
    nCount = CurrentDb.Containers(KEY_MODULES).Documents.Count
    nSuccessful = outputContainerModules(sFolder, KEY_MODULES)

    'write to the log file and final message
    sLine = nSuccessful & vbTab & "of" & vbTab & nCount & vbTab & KEY_MODULES & " exported"
    writeFile m_sLogPath, sLine, True
    sMessage = sMessage & vbTab & sLine & vbCrLf

    'output form modules
    If Not m_bCancel Then
        nCount = CurrentDb.Containers(KEY_FORMS).Documents.Count
        nSuccessful = outputContainerModules(sFolder, KEY_FORMS)

        'write to the log file and final message
        sLine = nSuccessful & vbTab & "of" & vbTab & nCount & vbTab & "Form Modules exported"
        writeFile m_sLogPath, sLine, True
        sMessage = sMessage & vbTab & sLine & vbCrLf
    End If

    'output report modules
    If Not m_bCancel Then
        nCount = CurrentDb.Containers(KEY_REPORTS).Documents.Count
        nSuccessful = outputContainerModules(sFolder, KEY_REPORTS)

        'write to the log file and final message
        sLine = nSuccessful & vbTab & "of" & vbTab & nCount & vbTab & "Report Modules exported"
        writeFile m_sLogPath, sLine, True
        sMessage = sMessage & vbTab & sLine & vbCrLf
    End If

    If Len(sMessage) Then
        MsgBox sMessage, vbInformation Or vbOKOnly, "OutputModules"
    End If

End Sub

Private Function outputContainerModules( _
        ByVal sFolder As String, _
        ByVal sKey As String) As Long

    Dim n As Long
    Dim nCount As Long
    Dim sName As String
    Dim sPath As String

    On Error GoTo EH

    'refactored this to use reference to Documents,
    'but the object reference doesn't stick around
    'and I had to roll back to this which isn't as pretty.
    'but this works (and if it ain't broke...)
    For n = 0 To CurrentDb.Containers(sKey).Documents.Count - 1

        nCount = nCount + 1
        sName = CurrentDb.Containers(sKey).Documents(n).Name

        Select Case sKey
            Case KEY_FORMS
                sName = "Form_" & sName
            Case KEY_REPORTS
                sName = "Report_" & sName
        End Select

        sPath = sFolder & "\" & sName & ".txt"
        DoCmd.OutputTo acOutputModule, sName, acFormatTXT, sPath, False

    Next 'n

    outputContainerModules = nCount

    Exit Function

EH:
    nCount = nCount - 1

    Select Case Err.Number
        Case 2289 'can't output the module in the requested format.

            'TODO: research - I think this happens when a Form/Report doesn't have a module
            Resume Next

        Case Else
            Dim sMessage As String

            writeError Err, sKey, sName, nCount

            sMessage = "An Error ocurred outputting " & sKey & ": " & sName & vbCrLf & vbCrLf _
                & "Number " & Err.Number & vbCrLf _
                & "Description:" & Err.Description & vbCrLf & vbCrLf _
                & "Click [Yes] to continue with export or [No] to stop."

            If vbYes = MsgBox(sMessage, vbQuestion Or vbYesNo Or vbDefaultButton2, "Error") Then
                Resume Next
            Else
                m_bCancel = True
                outputContainerModules = nCount
            End If

    End Select

End Function

Private Function writeFile( _
        ByVal sPath As String, _
        ByRef sMessage As String, _
        Optional ByVal bAppend As Boolean) As Boolean

    'Dim oFSO as Object
    'Dim oStream as Object
    'Const ForWriting As Long = 2
    'Const ForAppending As Long = 8
    'Dim eFlags As Long
    Dim oFSO As FileSystemObject
    Dim oStream As TextStream
    Dim eFlags As IOMode

    On Error GoTo EH

    'Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
    Set oFSO = New FileSystemObject

    If bAppend Then
        eFlags = ForAppending
    Else
        eFlags = ForWriting
    End If

    Set oStream = oFSO.OpenTextFile(sPath, eFlags, True)
    oStream.WriteLine sMessage

    writeFile = True

    GoTo CLEAN
EH:
    writeFile = False

CLEAN:
    If Not oFSO Is Nothing Then
        Set oFSO = Nothing
    End If
    If Not oStream Is Nothing Then
        Set oStream = Nothing
    End If
End Function

Private Sub writeError( _
    ByRef oErr As ErrObject, _
    ByVal sType As String, _
    ByVal sName As String, _
    ByVal nCount As Long)

    Dim sMessage As String

    sMessage = "An Error ocurred outputting " & sType & ": " & sName & " (" & nCount & ")" & vbCrLf _
        & "Number " & oErr.Number & vbCrLf _
        & "Description:" & oErr.Description & vbCrLf & vbCrLf

    writeLog sMessage

End Sub

Private Sub writeLog( _
    ByRef sMessage As String)

    On Error GoTo EH

    writeFile m_sLogPath, sMessage & vbCrLf, True

    Exit Sub
EH:
    'swallow errors?
End Sub


Private Function isDir(ByVal sPath As String) As Boolean
    On Error GoTo EH

    If Right$(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If

    If Dir$(sPath & ".", vbDirectory) = "." Then
        isDir = True
    ElseIf Len(sPath) = 3 Then
        If Dir$(sPath, vbVolume) = Left(sPath, 1) Then
            isDir = True
        End If
    End If

    Exit Function
EH:
    isDir = False
End Function

【讨论】：

以上是关于从 Microsoft Access 导出代码的主要内容，如果未能解决你的问题，请参考以下文章

Python 导出报告 Microsoft Access 使用 win32com.client

仅在 Microsoft access 更新时将 Microsoft Access 导出到 Mysql

如何将 pandas DataFrame 导出到 Microsoft Access？

将 Microsoft Access 表单导出为 HTML 的工具 [关闭]

将 sqlSave 与 Microsoft Access 数据库一起使用

Microsoft Access 中有没有一种方法可以从具有复合主键的 Excel 文件中导入？