我想对数百个 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 中回答，但它是首选。
