Private Sub Command1_Click()
Dim cn As rdoConnection
Dim ps As rdoPreparedStatement
Dim rs As rdoResultset
Dim strConnect As String
Dim strSQL As String
'open a connection to the pubs database using DSNless connections
'change the Server argument to match your SQL Server
strConnect = "Driver={SQL Server}; Server=myserver; " & _
"Database=pubs; Uid=sa; Pwd="
Set cn = rdoEnvironments(0).OpenConnection(dsName:="", _
Prompt:=rdDriverNoPrompt, _
ReadOnly:=False, _
Connect:=strConnect)
strSQL = "Select so.name,sc.name,st.name,sc.length " & _
"FROM syscolumns sc,master..systypes st,sysobjects so " & _
"WHERE sc.id in (select id from sysobjects where type ='P')" & _
" AND so.type ='P' " & _
"AND sc.id = so.id " & _
"AND sc.type = st.type " & _
"AND sc.type <> 39"
'create a prep stmt for the stored proc call
Set ps = cn.CreatePreparedStatement("MyPs", strSQL)
Set rs = ps.OpenResultset(rdOpenStatic)
'add the first resultset to a list box
list1.AddItem "SP Name,Param Name,Data Type,Length"
While Not rs.EOF
list1.AddItem rs(0) & " , " & rs(1) & " , " & rs(2) & " , " & _
rs(3)
rs.MoveNext
Wend
'Close the resultset and the connection and set both to nothing
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Private Sub Form_Load()
Command1.Caption = "List all Stored Procedures"
End Sub
Private CN As ADODB.Connection
Private RS As ADODB.Recordset
Private strTableName As String '用来存放表名
Private intLastCol As String
Private intLastSort As Integer
Set RS = CN.OpenSchema(adSchemaTables)
cobTable.Clear
Do Until RS.EOF
If RS("TABLE_TYPE") = "TABLE" Then
cobTable.AddItem RS("TABLE_NAME")
End If
RS.MoveNext
Loop
RS.Close
Set RS = New ADODB.Recordset
Set RS.ActiveConnection = CN
RS.CursorLocation = adUseClient
RS.LockType = adLockOptimistic
RS.CursorType = adOpenStatic
Private Sub cobTable_Click()
Me.MousePointer = 11
strTableName = cobTable.Text
If Not strTableName = "" Then
Dim strSql As String
On Error GoTo MyErr
strSql = "select * from " & strTableName
RS.Open strSql
Dim n As Integer
Dim m As Integer
lstvData.ListItems.Clear
lstvData.ColumnHeaders.Clear
For m = 0 To RS.Fields.Count - 1
lstvData.ColumnHeaders.Add , , RS.Fields(m).Name
Next m
'把每一个字段名加入到 lstvData 的 ColumnHeaders 。lstvData 是一个 listView 控件。
If RS.RecordCount > 0 Then
RS.MoveFirst
For n = 1 To RS.RecordCount '添加没一条纪录。
With lstvData.ListItems.Add(, , RS(RS.Fields(0).Name) & "")
For m = 1 To RS.Fields.Count - 1 '添加每一个字段。
.ListSubItems.Add , , RS(RS.Fields(m).Name) & ""
Next m
End With
RS.MoveNext
Next n
End If
labRecordCount.Caption = RS.RecordCount & " Records" '这个表的总纪录数。
RS.Close
End If
Me.MousePointer = 0
Exit Sub
MyErr:
MsgBox Err.Description, , "Error"
Err.Clear
Me.MousePointer = 0
End Sub