Quero executar o RegEx no código SQL completo de centenas de consultas do MS Access que faço um loop com o VBA em todos os bancos de dados do Access que podem ser encontrados em uma pasta.
O atributo "SQL" do objeto de consulta já vem como uma String, e se você copiar o código da janela Locals para algum editor, ele será cortado em 255 caracteres:
Por isso:
Aqui está o código até agora, embora esta pergunta também possa ser respondida sem código, e uma resposta não precisa usar o exemplo de código:
Para o padrão RegEx, consulte também MS Access VBA não pode lidar com lookarounds. É necessária uma correspondência dupla de RegEx antecipada/tardia. "Erro em tempo de execução '5017': erro definido pelo aplicativo ou definido pelo objeto" - Stack Overflow com um padrão Regex que também funcionaria se houvesse apenas uma coluna ou se a coluna "erro" fosse a primeira coluna, ou se o coluna vizinha não termina com AS .... Lá, o código apenas procura a vírgula antes do AS .... Isso não ajudará se você tiver vírgulas dentro da definição da coluna (que eu não tenho).
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
Portanto, este guia funciona, mas funciona apenas para códigos SQL mais curtos: Obtendo string sql de uma consulta :
Private Function GetQuerySQL(MyQueryName as String) as String
Dim QD As DAO.QueryDef
Set QD = CurrentDb.QueryDefs(MyQueryName)
GetQuerySQL=QD.SQL
End Function
Como obtenho o código SQL completo que pode ter mais de 255 caracteres de uma variável String, percorrendo todas as consultas e todos os bancos de dados de um diretório? Isso não precisa ser respondido em VBA, mas seria a primeira escolha.
