如何获取文件夹的所有 MS Access 数据库中所有查询的完整 sql 代码？

我想对数百个 MS Access 查询的完整 SQL 代码运行 RegEx，我使用 VBA 对文件夹中可以找到的所有 Access 数据库进行循环。

查询对象的“SQL”属性已经作为字符串出现，如果将代码从本地窗口复制到某个编辑器，它已被削减为 255 个字符：

因此：

这是到目前为止的代码，尽管这个问题也可以在没有代码的情况下得到回答，并且答案不需要使用代码示例：

有关 RegEx 模式，另请参阅MS Access VBA 无法处理环视。需要双早/晚正则表达式匹配。“运行时错误‘5017’：应用程序定义或对象定义的错误” -与正则表达式模式堆栈溢出，如果只有一列或“错误”列是第一列，或者如果相邻列不以 结尾AS ...。在那里，代码只是搜索 之前的逗号AS ...。如果列定义中有逗号（我没有），这将无济于事。

Option Compare Database

Function extractErrorColumnAndWhereCondition(obj_SQL As String) As Variant
    Dim error As String
    Dim whereCondition As String
    Dim regex As Object
    Dim matches As Object
    Dim regexPattern As String
    
    regexPattern = "AS (\w+)(?: AS error)? INTO (\w+) FROM.*WHERE(.*)"
    
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Global = False
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = regexPattern
    End With
    
    Set matches = regex.Execute(obj_SQL)
    
    If matches.Count > 0 Then
        error = matches(0).SubMatches(0)
        whereCondition = matches(0).SubMatches(2)
        extractErrorColumnAndWhereCondition = Array(error, whereCondition)
    Else
        extractErrorColumnAndWhereCondition = Array("", "")
    End If
End Function

Sub DurchsucheAccessfile_Nameen()
    Dim fso As Object
    Dim fld As Object
    Dim db As Object
    Dim rs As Object
    Dim array_output As Variant
    Dim obj_SQL As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
'    Set fld = fso.GetFolder(".\my_folder")
    Set fld = fso.GetFolder("K:\MS Access\my_folder")
    
    Dim targetDB As Object
    Dim object_type As String
    Dim object_kind As String
'    Set targetDB = Application.DBEngine.Workspaces(0).OpenDatabase(".\my_file.accdb")
    Set targetDB = Application.DBEngine.Workspaces(0).OpenDatabase("K:\MS Access\my_file.accdb")
    
    For Each file In fld.Files
        file_Name = file.Name
        If Right(file_Name, 4) = ".mdb" Or Right(file_Name, 6) = ".accdb" Then
            Set db = Application.DBEngine.Workspaces(0).OpenDatabase(file.Path)
            
            For Each obj In db.TableDefs
                obj_Name = obj.Name
                If Left(obj_Name, 4) <> "MSys" And Left(obj_Name, 1) <> "~" Then
                    Set rs = targetDB.OpenRecordset("my_file")
                    rs.AddNew
                    rs("file_Name").Value = file_Name
                    rs("obj_Name").Value = obj_Name
                    rs("LastUpdated").Value = obj.LastUpdated
                    If InStr(1, obj_Name, "Formular", vbTextCompare) Then
                        object_type = "Formular"
                    ElseIf InStr(1, obj_Name, "TAB", vbTextCompare) Or InStr(1, obj_Name, "dbo_", vbTextCompare) Then
                        object_type = "Table"
                    Else
                        object_type = "Unknown"
                    End If
                    rs("object_type").Value = object_type
                    If object_type = "Table" Then
                        If InStr(1, obj_Name, "_v_", vbTextCompare) Then
                            object_kind = "Linked View"
                        ElseIf InStr(1, obj_Name, "_tbl", vbTextCompare) Then
                            object_kind = "Linked Table"
                        Else
                            object_kind = "loaded"
                        End If
                    ElseIf object_type = "Formular" Then
                        object_kind = "Formular"
                    Else
                        object_kind = "Unknown"
                    End If
                    rs("object_kind").Value = object_kind
                    rs("SourceTableName").Value = obj.SourceTableName
                    rs.Update
                End If
            Next obj
            
            
            For Each obj In db.QueryDefs
                obj_Name = obj.Name
                If Left(obj_Name, 1) <> "~" Then
                    rs.AddNew
                    rs("file_Name").Value = file_Name
                    rs("obj_Name").Value = obj_Name
                    rs("LastUpdated").Value = obj.LastUpdated
                    rs("object_type").Value = "Abfrage"
                    obj_SQL = obj.SQL
                    If InStr(1, obj_SQL, "into ", vbTextCompare) Then
                        object_kind = "select into"
                    Else
                        object_kind = "select"
                    End If
                    rs("object_kind").Value = object_kind
                    rs("Query_SQL").Value = obj_SQL
                    array_output = extractErrorColumnAndWhereCondition(obj_SQL)
                    If IsArray(array_output) Then
                        rs("error").Value = array_output(0)
                        rs("Where_Condition").Value = array_output(1)
                    End If
                    rs.Update
                End If
            Next obj
            
            db.Close
        End If
    Next file
    
    targetDB.Close
End Sub

因此，本指南有效，但仅适用于较短的 SQL 代码：从查询中获取 sql 字符串：

Private Function GetQuerySQL(MyQueryName as String) as String
Dim QD As DAO.QueryDef
 
Set QD = CurrentDb.QueryDefs(MyQueryName)
GetQuerySQL=QD.SQL
 
End Function

如何获取比字符串变量的 255 个字符长的完整 SQL 代码，并循环遍历目录的所有查询和所有数据库？这个问题不必在 VBA 中回答，但它是首选。