原文：http://access911.net/72FAB31E17DCEAF3.htm

下列代码搜索整个 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