天天看點

VB 查詢SQL SERVER資料庫内容源碼 工程下載下傳

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