Article ID: 196959
Article Last Modified on 3/14/2005
CREATE TABLE dbo.TestTable_SN
(
col1 varchar (25) NOT NULL DEFAULT (user_name()),
col2 datetime NOT NULL DEFAULT (getdate())
)
GO
Private strSQL As String
Private strConnect As String
Dim ADOCn As ADODB.Connection
Public Function GetData() As ADOR.Recordset
If Not ADOCn Is Nothing Then
Else
Err.Raise vbObjectError + 98, "ADOGetData", "No valid Connection"
End If
Dim ADORs As ADOR.Recordset
Set ADORs = New ADOR.Recordset
With ADORs
.CursorLocation = adUseClient
.ActiveConnection = ADOCn
.CursorType = adOpenForwardOnly
.LockType = adLockBatchOptimistic 'batch updates.
.Open strSQL
End With
'DisConnect the Recordset from the connection.
Set ADORs.ActiveConnection = Nothing
Set GetData = ADORs
Set ADORs = Nothing
End Function
Private Property Get ConnectStr() As String
ConnectStr = strConnect
End Property
Private Property Let ConnectStr(strCn As String)
strConnect = strCn
End Property
Public Property Get SQL() As String
SQL = strSQL
End Property
Public Property Let SQL(nSQL As String)
strSQL = nSQL
End Property
Public Sub UpdateRS(ByVal ClientRs As ADOR.Recordset)
Dim ADORs As New ADOR.Recordset
If Not ADOCn Is Nothing Then
Else
Err.Raise vbObjectError + 99, "ADOUpdate", "No valid Connection"
End If
ADORs.ActiveConnection = strConnect
ADORs.Open ClientRs
ADORs.UpdateBatch
End Sub
Public Sub ADOConnect(strConnect As String, Optional CnTimeOut As _
Integer = 20)
Set ADOCn = New ADODB.Connection
With ADOCn
.Provider = "MSDASQL" '"SQLOLEDB"
.CursorLocation = adUseClient
.ConnectionString = strConnect
.CommandTimeout = CnTimeOut
.Open
End With
ConnectStr = ADOCn
End Sub
Const strConnect = "Driver={SQL _
Server};Server=(local);Database=Pubs;Uid=Sa;Pwd="
Private Sub Command1_Click()
On Error GoTo ErrorHandler
Dim ADORs As ADOR.Recordset
Dim objADOData As ADOProc.ADOData
Dim rField As ADODB.Field
Dim iValue As Byte
' Instantiate the Data Object.
Set objADOData = New ADOProc.ADOData
With objADOData
.SQL = "SELECT * FROM TestTable_SN"
.ADOConnect strConnect, 15 'Establish connection.
End With
Set ADORs = New ADOR.Recordset
' Rtrn the Resultset from Data object.
Set ADORs = objADOData.GetData
' The Resultset is disConnected at this point.
ADORs.AddNew
' Fails (Remotely - DCOM) if quotes around the
' Date value instead of pound sign.
ADORs(0) = App.EXEName
ADORs(1) = #12/12/98#
ADORs.MarshalOptions = adMarshalModifiedOnly
objADOData.UpdateRS ADORs
MsgBox "Data Changed", vbOKOnly, "Data Object"
Exit Sub
ErrorHandler:
MsgBox "Change Failed:" & vbCrLf & Err.Number & vbCrLf & _
Err.Description, vbOKOnly, "Data Object"
Debug.Print Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
186342 HOWTO: Create a 3-Tier App using VB, MTS and SQL Server
Keywords: kbfix kbdatabase kbprb kbado210sp2fix KB196959