下列代码搜索整个 SQL SERVER 数据库，找所有 VarChar 字段，只要包含搜索字串的就报告。我在查看其他软件的结构时使用的一段代码，现在贴出来。
Function test2()
SearchAllDatabase "xk"
End Function
Function SearchAllDatabase(strFind As String)
Dim MyTableName As String
Dim MyFieldName As String
Dim MyDB As New ADOX.Catalog
Dim MyTable As ADOX.Table
Dim MyField As ADOX.Column
Dim pro
On Error GoTo Err_GetFieldDescription
Dim strCnn As String
strConn = "Provider=SQLOLEDB.1;Password=;Persist Security Info=True;User ID=SA;Initial Catalog=;Data Source="
Dim Conn As New ADODB.Connection
Conn.Open strConn
Dim strSQL As String
MyDB.ActiveConnection = Conn
Dim Rs As New ADODB.Recordset
'CurrentProject.Connection.Execute "delete from 表1"
For Each MyTable In MyDB.Tables
If MyTable.Type = "table" Then
For Each MyField In MyTable.Columns
If MyField.Type = adVarChar Then
strSQL = strSQL & " or " & MyField.Name & " like '%" & strFind & "%'"
'CurrentProject.Connection.Execute "insert into 表1(a) values ('" & MyTable.Name & Chr(45) & MyField.Name & Chr(45) & FieldTypeD(MyField.Type) & Chr(45) & MyField.DefinedSize & "')"
End If
Next
DoEvents
If strSQL <> "" Then
strSQL = Right(strSQL, Len(strSQL) - 3)
strSQL = "select count(*) from " & MyTable.Name & " where " & strSQL & vbCrLf
Rs.Open strSQL, Conn, 1, 1
If Rs(0) > 0 Then
Debug.Print MyTable.Name & " 中找到 " & Rs(0) & " 条指定的数据"
End If
Rs.Close
End If
strSQL = ""
End If
Next
Set MyDB = Nothing
Conn.Close
Bye_GetFieldDescription:
Exit Function
Err_GetFieldDescription:
Beep
MsgBox Err.Description, vbExclamation
GetFieldDescription = Null
Resume Bye_GetFieldDescription
End Function
