1.查询模块:
Public Function Exesql(ByVal sql As String, msgstring As String) As ADODB.Recordset
Dim cn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
On Error GoTo runsql_error
cn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=student"
cn.Open
cmd.ActiveConnection = cn
cmd.CommandType = adCmdText
cmd.CommandText = sql
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockReadOnly
rs.Open cmd
Set Exesql = rs
Exit Function
runsql_error:
   MsgBox "错误：" & Err.Description
End Function
 
2.综合模块:
Public Function Executesql(ByVal sql As String, msgstring As String) As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim stokens() As String
  On Error GoTo executesql_error
  stokens = Split(sql)
Set cnn = New ADODB.Connection
cnn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=student"
If InStr("insert,delete,update", UCase$(stokens(0))) Then
  cnn.Execute sql
  msgstring = stokens(0) & "query successful"
Else
  Set rst = New ADODB.Recordset
  rst.Open Trim$(sql), cnn, adOpenKeyset, adLockOptimistic
  Set Executesql = rst
  msgstring = "查询到" & rst.RecordCount & "条记录"
End If
executesql_exit:
Set rst = Nothing
Set cnn = Nothing
Exit Function
executesql_error:
msgstring = "查询错误" & Err.Description
Resume executesql_exit
End Function
 
3.调用示例:
Private Sub Command1_Click()
Dim txtsql As String
Dim mrc As ADODB.Recordset
Dim msgtext As String
txtsql = "select * from student where 学号='" & Text1.Text & "' "
Set mrc = Exesql(txtsql, msgtext)
Set DataGrid1.DataSource = mrc
End Sub