〓〓〓〓〓〓〓〓〓〓OpensqlServer函数相关定义声明等 Start
Public Conn As New ADODB.Connection
Public OpensqlOK As Boolean
Public ShowsqlRsErr As Boolean
'〓〓〓〓〓〓〓〓〓〓OpensqlServer函数相关定义声明等 End
'┏〓〓〓〓〓〓〓〓〓 OpensqlServer,start 〓〓〓〓〓〓〓〓〓┓
'［详介］：
'参数输入：服务器IP，数据库名，用户，密码
'［简介］：
'打开sqlserver数据库
Function OpensqlServer(Server As String,dbname As String,Uid As String,Pwd As String) As Boolean
   'VB源码，帮你写函数，帮你写代码，帮你写模块，帮你设计软件
   '--需要什么函数或功能，可以联系我。
   '版权所有，请保留作者信息.QQ：1085992075
   '如需商业用途请联系作者
      On Error GoTo Err
      'Server如：XJ,HOME
      Dim ConnStr As String
      ConnStr = "Provider=sqlOLEDB;Password=" & Pwd & ";Persist Security Info=True;User ID=" & Uid & ";Initial Catalog=" & dbname & ";Data Source=" & Server & ";Connect Timeout=50" 'msdb
      Conn.open ConnStr
      OpensqlOK = True
      OpensqlServer = True
      Exit Function
      Err:
      If ShowsqlRsErr Then
          MsgBox Err.Number & vbCrLf & Err.Description
      End If
End Function
'┗〓〓〓〓〓〓〓〓〓  OpensqlServer,end  〓〓〓〓〓〓〓〓〓┛

先打开OpensqlServer，再查

'┏〓〓〓〓〓〓〓〓〓 GetRs,start 〓〓〓〓〓〓〓〓〓┓
Function GetRs(sql,Optional ErrInfo As String) As ADODB.Recordset
   '[mycode_id:1843],edittime:2011-1-17 下午 08:34:21
   On Error GoTo Err
   Dim Rs As New ADODB.Recordset
   'Set Rs = CreateObject("adodb.recordset")
   Rs.open sql,Conn,1,3
   Set GetRs = Rs
   Exit Function
   Err:
   ErrInfo = Err.Description
End Function
'┗〓〓〓〓〓〓〓〓〓  GetRs,end  〓〓〓〓〓〓〓〓〓┛

sub test()

OpensqlServer  "192.168.1.2","db1","sa","2222"
Dim Rs As New ADODB.Recordset
set rs=getrs("select * from user")
msgBox rs("user")

end sub