I want to run RegEx on the full SQL code of hundreds of MS Access queries that I loop through with VBA over all Access databases that can be found in a folder.
The "SQL" attribute of the query object comes in already as a String, and if you copy the code from the Locals Window to some editor, it has been cut at 255 characters:
Thus:
Here is the code so far, though this question might be answered without code as well, and an answer does not need to take up the code example:
For the RegEx pattern, see also MS Access VBA cannot deal with lookarounds. Double early/late RegEx match needed. "Run-time error '5017': Application-defined or object-defined error" - Stack Overflow with a Regex pattern that would also work if there was just one column or if the "error" column was the first column, or if the neighboured column does not end with AS .... There, the code just searches for the comma before the AS .... That will not help if you have commas inside the column definition (which I do not have).
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
Thus, this guide works, but it works only for shorter SQL code: Getting sql string from a query:
Private Function GetQuerySQL(MyQueryName as String) as String
Dim QD As DAO.QueryDef
Set QD = CurrentDb.QueryDefs(MyQueryName)
GetQuerySQL=QD.SQL
End Function
How do I get the full SQL code that can be longer than the 255 characters of a String variable, looped through all queries and all databases of a directory? This does not have to be answered in VBA, but it would be first choice.
