Article ID: 189838
Article Last Modified on 3/2/2005
Private Sub Command1_Click()
'This causes an error.
'----------------------------
Dim cn As New Connection
Dim rs As New ADODB.Recordset
Dim cmd As New ADODB.Command
'This does not cause an error.
'----------------------------
' Dim cn As Connection
' Dim rs As ADODB.Recordset
' Dim cmd As ADODB.Command
' Set cn = New Connection
' Set cmd = New Command
Dim i As Integer, Records As Integer
Dim SQL As String
Dim bFlag As Boolean
cn.ConnectionString = "DRIVER={sql server}" & _
";SERVER=YourServer;DATABASE=pubs;UID=<username>;PWD=<strong password>"
'--OR--
'cn.ConnectionString = "Provider=SQLOLEDB;" & _
"Data Sourcce=YourServer;Initial Catalog=pubs;User ID=<username>;Password=<strong password>"
cn.Open
On Error Resume Next
cn.Execute "DROP TABLE x"
On Error GoTo eh
cn.Execute "CREATE TABLE x(rdint INT CONSTRAINT " & _
"pk_rdint PRIMARY KEY, rdchar CHAR(255) )"
SQL = ""
SQL = SQL & "INSERT INTO x(rdint, rdchar) VALUES(1, 'ONE') "
SQL = SQL & "INSERT INTO x(rdint, rdchar) VALUES(2, 'TWO') "
SQL = SQL & "INSERT INTO x(rdint, rdchar) VALUES(3, 'THREE') "
cmd.CommandText = SQL
cmd.CommandType = adCmdText
cmd.ActiveConnection = cn
i = 1
bFlag = True
Set rs = cmd.Execute(Records)
While bFlag = True
If rs Is Nothing Then
bFlag = False
Else
Debug.Print "i: " & i; " State:"; rs.State;
Debug.Print " Records Affected:"; Records;
Debug.Print " Is Null: " & IsNull(rs)
i = i + 1
Set rs = rs.NextRecordset(Records)
End If
Wend
Exit Sub
eh:
MsgBox Err.Number & " -- " & Err.Description
End Sub
Keywords: kbprb KB189838