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 | 
1004164
