ado|資料 Option Explicit
Public pubcn As New ADODB.Connection
Dim temp_i As Integer
''串連資料庫
Public Sub GetConnect()
On Error GoTo errorhandler:
Dim constr As String
If Not (pubcn.State = 0) Then
pubcn.Close
End If
pubcn.CursorLocation = adUseClient
pubcn.ConnectionTimeout = 5
pubcn.Open "Provider=sqloledb;" & _
"Network Library=DBMSSOCN;" & _'指明採用IP+連接埠方式尋找Sql Server
"Data Source=172.17.21.125,1433;" & _
"Initial Catalog=hpdata;" & _
"User ID=user;" & _
"Password=password;" & _
"Encrypt=yes"
pubcn.DefaultDatabase = "hpdata" ''!!!!!!!!!!!!!!!!
Exit Sub
errorhandler:
Dim msg As Integer
msg = MsgBox("串連時發生錯誤:" & Err.Number & Err.Description & Err.Source & "請將此資訊發至郵箱", vbOKOnly)
End Sub
''簡單查詢得到資料集////////////////////////////////////////////////////////
Public Function GetRS(sqlstr As String) As ADODB.Recordset
On Error GoTo errorhandler
Call GetConnect
Set GetRS = New ADODB.Recordset
GetRS.Open sqlstr, pubcn, adOpenStatic, adLockOptimistic
Set GetRS.ActiveConnection = Nothing
pubcn.Close
Exit Function
errorhandler:
Dim i As Integer
i = MsgBox(sqlstr & ":::::::" & Err.Description & Err.HelpContext, vbOKCancel)
End Function
'同步資料集
Public Sub UpdateRS(Rs As ADODB.Recordset, Optional RequerryFlag As Integer)
Call GetConnect
With Rs
.ActiveConnection = pubcn
.Update
'If (Not IsMissing(RequerryFlag)) And RequerryFlag = 1 Then ''改於2004年2月6日為修除記錄本客戶號查詢的修改無法資料同步而設
' .Requery
'End If
.ActiveConnection = Nothing
End With
pubcn.Close
End Sub
'執行帶有參數對象的查詢得到資料集
Public Sub GetRSFromCmd(Cmd As ADODB.Command, str As String, Rs As ADODB.Recordset)
On Error GoTo errorhandler
Call GetConnect
If Not (Cmd.State = adStateClosed) Then
Cmd.Cancel
Cmd.ActiveConnection = Nothing
End If
With Cmd
.ActiveConnection = pubcn
.CommandTimeout = 5
.CommandType = adCmdText
.CommandText = str
End With
If Not (Rs.State = 0) Then
Rs.Close
End If
Rs.Open Cmd, , adOpenStatic, adLockOptimistic
Rs.ActiveConnection = Nothing
With Cmd
.ActiveConnection = Nothing
End With
pubcn.Close
Exit Sub
errorhandler:
temp_i = MsgBox(str & Err.Number & Err.Description & Err.Source, vbOKOnly)
End Sub
'執行無返回結果的sql語句
Public Sub CnExecute(ByVal Qstr As String, ByRef RecordNumber As Long, Optional QRs As ADODB.Recordset)
&n
