我想在数百个 MS Access 查询的完整 SQL 代码上运行 RegEx，我使用 VBA 循环遍历文件夹中可以找到的所有 Access 数据库。
查询对象的“SQL”属性已经作为字符串出现，如果你将代码从本地窗口复制到某个编辑器，它会被剪切为 255 个字符：
因此：
这是到目前为止的代码，尽管这个问题也可以在没有代码的情况下得到回答，并且答案不需要采用代码示例：
对于 RegEx 模式，另请参阅MS Access VBA 无法处理环视。需要双重早期/晚期 RegEx 匹配。“运行时错误‘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 中回答，但它是首选。
答案1
我在这里犯了一个初学者的错误。如果我Debug.Print obj.SQL（查询的 SQL 字符串），我会在“立即窗口”中得到完整的 SQL 代码。
因此，String 变量不会在 255 个字符处被截断，只有在“本地窗口”中，预览时才会被截断。由于我将预览文本从“本地窗口”复制到编辑器中来计算字符数，因此我错误地认为对于这样的 String 类型，它会在 255 个字符处被截断。
因此，上面的代码已经是回答该问题所需要的。