How to Interrogate SQL Server Tables for Specific Values - Here's how to do it in MS Access

In MS Access I have a routine as follows that interrogates all the
tables in the database looking for a certain value.

I am looking for similar routine for SQL Server. It needs to to be
run at the server and not link to the tables.

First the MS Access routine runs to create three tables. XYZTables,
XYZFields, and XYZResults and populates XYZTables and XYZFields.
XYZFields is needed for the Interrogation routine that follows:

Public Sub DocumentTables()
Dim db As DAO.Database, tbl As DAO.TableDef, fld As DAO.Field
Dim rstTable As DAO.Recordset, rstField As DAO.Recordset
Dim t As String, strQuery As String
Dim strTableSet As String, strFieldSet As String

strSQL = "CREATE TABLE XYZTables " & _
"(TableName TEXT CONSTRAINT " & _
" PrimaryKey PRIMARY KEY, " & _
" TableRecords Number) "
CurrentDb.Execute strSQL, dbFailOnError

strSQL = "CREATE TABLE XYZFields " & _
"(TableName CHAR, " & _
"FieldName CHAR, " & _
"DataType CHAR, " & _
"DataSize Number, " & _
"FieldDesc CHAR, " & _
"SearchValue CHAR) "
CurrentDb.Execute strSQL, dbFailOnError

strSQL = "CREATE TABLE XYZResults " & _
"(TableName CHAR, " & _
"FieldName CHAR, " & _
"DataType CHAR, " & _
"DataSize Number, " & _
"FieldDesc CHAR, " & _
"SearchValue CHAR) "
CurrentDb.Execute strSQL, dbFailOnError

strTableSet = "xyzTables"
strFieldSet = "xyzFields"

DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM [" & strTableSet & "];"
DoCmd.RunSQL "DELETE * FROM [" & strFieldSet & "];"
DoCmd.SetWarnings True

Set db = CurrentDb
Set rstTable = db.OpenRecordset(strTableSet, dbOpenDynaset)
Set rstField = db.OpenRecordset(strFieldSet, dbOpenDynaset)

Debug.Print

For Each tbl In db.TableDefs
Debug.Print tbl.Name
If tbl.Attributes = 0 Then
With rstTable
.AddNew
.Fields("TableName") = tbl.Name
.Fields("TableRecords") = tbl.RecordCount
On Error Resume Next
.Fields("TableDesc") =
tbl.Properties("Description").Value
On Error GoTo 0
.Update
End With
For Each fld In tbl.Fields
'add new record for each field in each table,
containing
'table, field, data type of field
With rstField
.AddNew
.Fields("TableName").Value = tbl.Name
.Fields("FieldName").Value = fld.Name
.Fields("DataType").Value =
GetFieldDataType(fld.Type)
.Fields("DataSize").Value = fld.Size
On Error Resume Next
.Fields("FieldDesc").Value =
fld.Properties("Description").Value
On Error GoTo 0
.Update
End With
Next fld
End If
Next tbl

Debug.Print

rstField.Close
rstTable.Close
Set fld = Nothing
Set tbl = Nothing
Set db = Nothing
End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Function InterrogateDB()
On Error GoTo Err_Line

Dim db As DAO.Database
Dim rsXYZFields As DAO.Recordset
Dim mTable As String
Dim mField As String
Dim strSQL As String
Dim strFIND As String
strFIND = InputBox("Enter the field name fragment:") ' This
prompts user for a value to search for.


Set db = CurrentDb
'Open the Table/Fields table


Set rsXYZFields = db.OpenRecordset("xyzFields", dbOpenSnapshot)


With rsXYZFields
.MoveFirst
Do Until .EOF
mTable = "[" & Trim(.Fields(0)) & "]"
mField = "[" & Trim(.Fields(1)) & "]"

If DCount("*", mTable, mField & " Like '*" & _
strFIND & "*'") > 0 Then
strSQL = "INSERT INTO xyzResults ( TableName, " &
_
"FieldName, SearchValue ) VALUES ( '" & mTable &
"', '" & _
mField & "', '" & strFIND & "' )"
db.Execute strSQL, dbFailOnError

End If
.MoveNext
Loop
End With
rsXYZFields.Close
Set rsXYZFields = Nothing
db.Close
Set db = Nothing
Exit Function


Err_Line:
MsgBox "Error occurred when inserting record"
Resume Next


.

Relevant Pages

  • Create a hyperlink in Lotus Notes
    ... Public Function SendMail(strName As String, ... Dim fileNamesAs String ... On Error GoTo NotesError ... ' Open Mail Database Start ...
    (microsoft.public.access.modulesdaovba)
  • Re: On Error not working as I thought
    ... on error goto 0 ... Or use a string. ... Dim TestStr As String ... Dim UseThisFolder As String ...
    (microsoft.public.excel.misc)
  • Re: On Error not working as I thought
    ... on error goto 0 ... Or use a string. ... Dim TestStr As String ... Dim UseThisFolder As String ...
    (microsoft.public.excel.misc)
  • Re: Open MS Word in Access 2007
    ... "Gina Whipp" wrote: ... Dim xstring As String ... On Error GoTo Err_PrintLetter_Click ... Dim inCriteria As String ...
    (microsoft.public.access.modulesdaovba)
  • Re: Open MS Word in Access 2007
    ... "Gina Whipp" wrote: ... Dim xstring As String ... On Error GoTo Err_PrintLetter_Click ... Dim inCriteria As String ...
    (microsoft.public.access.modulesdaovba)
Loading