VB 6 ADO

["Shannon ODonnell" <sodonnell@xxxxxxxxxxxxxxxxxxxxxxxxx>]

Never mind.I figured it out.  I was using a double quote instead of a single
quote on the Where clause.  D'oh!

 

From: Shannon ODonnell [mailto:sodonnell@xxxxxxxxxxxxxxxxxxxxxxxxx] 
Sent: Tuesday, April 14, 2009 2:59 PM
To: 'PC Technical Discussion for iSeries Users'
Subject: VB 6 ADO

 

Hi,

 

I need to create a very tiny, very quick VB 6 program to run an experiment
on data access.

 

I haven't had to write any VB6 ADO stuff for several years so I'm quite
rusty here.

 

I found a small code sample on the web that will work fine for all I want to
do, but I'm having trouble getting the SELECT to be syntactically correct.
Not sure why.


Can a VB person take a quick peek at this and tell me why the  WHERE clause
would be throwing errors?

 

 

txtFieldType is defined as maxlength 2 (char).  The field in the AS/400
database is also 2 characters.

 

If I do not use a WHERE clause, it works fine.  With a WHERE clause, it
craps out.

 

 

Thanks!

 

Shannon O'Donnell

 

 

Private Sub cmdLoadIseries_Click()

 

' This requries that there be a DSN setup on the user's box. Make this a
system DSN

' called "MYAS400"

' and on the "Packages(S)" tab, un-check the "Enable extended Dynamic
support"

 

 

Dim objConn As New ADODB.Connection, objRs As New ADODB.Recordset

Dim ObjCommand As New ADODB.Command

Dim X As Long, Y As Long

Dim UserId, PassWord, Library As String

Dim ThisInteger As Integer

Dim BadField, ThisCountA As String

Dim ThisCount As Long

Dim CNS As String

Dim Apost As String

Dim sDesc As String

 

On Error GoTo ErrorHandler ' Enable error handler

 

 

UserId = UCase(txtUser.Text)

PassWord = UCase(txtPassword.Text)

Library = UCase(txtLibrary.Text)

 

If Library = "" Then

msg = "The library is blank WTF!!!"

MsgBox msg, vbOKOnly

Exit Sub

End If

 

frmMain.MousePointer = vbHourglass

 

ThisCount = 0

 

CNS = "DSN=MYAS400;DRIVER=Client Access ODBC Driver (32-bit); " & "SYSTEM =
TheAS400; UID = " & UserId & ";PWD = " & PassWord

 

objConn.ConnectionString = CNS

 

objConn.Open

 

Apost = """"

 

sDesc = "SELECT TNAME FROM " & Library & ".AFILE WHERE DOCKTY = " & Apost &
txtFieldType.Text & Apost

 

MsgBox sDesc

 

'Now get the records

objRs.Open sDesc, objConn, adOpenDynamic, adLockOptimistic

'Loop until we've hit the EOF (end of file)

Do Until objRs.EOF = True

 

ThisCount = ThisCount + 1

'Move to the next record (important!!)

objRs.MoveNext

Loop

'Close the Recordset object

objRs.Close

 

'Delete the Recordset Object

Set objRs = Nothing

 

 

'Close the Connection object

objConn.Close

 

'Delete the Connection Object

Set objConn = Nothing

 

 

 

'objRs.Fields(11) = Cells(RowCount, 1).Value 'Shop Field

 

 

frmMain.MousePointer = 0

msg = "downloaded " & CStr(ThisCount) & " number of records from your file."

MsgBox msg, vbOKOnly

 

Exit Sub 'get out before the Error Handler kicks in

 

'//////////////////////////////////////////////////////////

ErrorHandler:

Select Case Err.Number

Case -2147217843

msg = "You must enter you User ID and Password: " & Err.Number _

& " Or your user ID and Password are not correct."

MsgBox msg, vbOKOnly

Case 13

msg = "You have text data in a numeric field (" & BadField & "). Fix and
re-Upload"

MsgBox msg, vbOKOnly

 

Case Else

msg = "Error is " & Err.numer & " / " & Err.Description

MsgBox msg, vbOKOnly

End Select

 

 

End Sub