Improve company productivity with a Business Account.Sign Up

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 347
  • Last Modified:

ADO Recordset.. Binding Access2000 Database to Fields?

I am writing a project use ADO to An Access2000 Database
I am connecting to the database using ADO.
Connecting to the ado source, checking data etc ....
Am i doing it the RIGHT way???
??1. Opening.....
Global rs As ADODB.Recordset
Global cnn As New ADODB.Connection
rs.Open "wol", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
    rs.Index = ("TITLE")
    Slider1.Max = rs.RecordCount - 1
??2. Binding Text Input Fields..
  Set TextTitle.DataSource = rs
    TextTitle.DataField = "Title"
    Set TextQuantity.DataSource = rs
    TextQuantity.DataField = "Quantity"
    QuantityInput = ""
I have tried the properties, does not seem to recognise.
??3. Checking that input is Numeric.
Private Sub QuantityInput_Change()
    If IsNumeric(QuantityInput) Then
        QuantityInput.Text = ""
    End If
End Sub
??4. Checking if Input Is +  or -
Private Sub Quantityinput_LostFocus()
    Dim TestMinus As String
    Dim TestLen As Integer

    TestLen = Len(QuantityInput)
    TestMinus = Mid(QuantityInput, TestLen, 1)
    If TestMinus <> "-" Then
        rs.Fields("quantity") = rs.Fields("quantity") + Val(QuantityInput)
        rs.Fields("quantity") = rs.Fields("quantity") - Val(QuantityInput)
    End If

    TextQuantity = rs.Fields("quantity")
End Sub


All the above is working, but it seems a little complicated.

I am relatively new to VB, please excuse it i am off the track a bit!

Would appreciate some advice as to my code, and also
any other better ways of doing it!!!
1 Solution
Anthony PerkinsCommented:
I can see a number of problems.  But if you could explain what you are trying to achieve it may be for the best.

1. Does the RecordCount property actually return a value (other than -1)  I suspect you may have to do one of two things to get it to give you a valid answer
a. rs.CursorLocation = adClient 'before opening the recordset
b. rs.MoveLast  'before checking the value of RecordCount

2. I have a personal aversion to bound controls so don't expect any positive comments here.  In any non-trivail app, they usually end up being more trouble than they are worth.

3 & 4 For the most part, as you have discovered, is a royal PITA.  The IsNumeric does not always work and the LostFocus event does not always fire.  You are better off, checking for the correct format when you update the record.

Hope this helps,
turnerrobAuthor Commented:
I have an Access2000 Database, with a large number of song titles.
I need the user to enter progressively the quantity of useage of each title.


Am i best to us a Bound Control.???
I avoided this , due to comments in the forum, that ADO is better.

If i use Bound.. Can i lose the path of where the file is loaded upon installation. (The user may install to another directory)

Please remember, i am only just starting in VB.!!!

Appreciate any help
To get the path u can use App.Path function. it will return path where ever application running.

The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

Anthony PerkinsCommented:
Some clarification is in order here.

The 2 object models that you can use with Access are DAO and ADO.  Both have their own Data Controls that allow you to bind other controls at design time.  You can still bind controls without using the Data Controls, but you have to write code to do that.

I am suggesting you do NOT bind your controls, either with a Data Control or otherwise.  Learn to read the data from a recordset and write it back to it.

Binding controls has nothing to do with where the data is located.  It is a separate issue.

If you think it would help, post your table structure and I will see if I can come up with some example that may help you.

turnerrobAuthor Commented:
Database Name    Accesswol.mdb...   Table=  Wol

My Access2000 Database File structure is.. (Wol)

Code       Text
Title      Text
Quantity   Number  (ie Accum Quantity)
There are nearly 100,000 records
I have an Index on Code  and Title

The program, basically, consists of.

A series of lookups on the title
a. After 3 characters are keyed in, a list box is filled
with all titles with these 3 characters in the first 3 positions.
b. A random lookup on the database for the characters in the title field, results displayed in list box.
The user clicks on the item in the list box, and to the right-->
Shows.. Title    The song title...........
        Extra Quantity                     Accum Quantity

The user enters  say 111 to Extra Quantity, this is added to Accum Quantity
The user then looks up next title  etc...

The program is only very simple.

Would appreciate advice as to the best way to handle Access2000 Tables etc in VB.
Ado seems hard work??

Hope i have given enough info.

Regards  Turnerrob

Anthony PerkinsCommented:
Let me take a look at it and will try and get back to you tomorrow.

turnerrobAuthor Commented:
Thanks, for your interest, much appeciated.
U can instead try writing the code

1)make standard module(i.e .bas file)
''conn is connection Object used
''for conecting to the database

Public con As ADODB.Connection
3)go to odbc in control panel,choose userdsn,then choose add,choose access driver,say finish,then choose database,give a dsn name.
4)In ur MDIform(if u have one or sdi form) write

Set con = New ADODB.Connection
con.Open "dsn=dsnname;uid=;pwd=;"

Set con = New ADODB.Connection app.path &"\" &"db.mdb"

voila  its connected.

write this code in ur form

Private Sub openrec(sql As String, rs As ADODB.Recordset, con As Connection, rstype As String, mode As String)
Set rs = New ADODB.Recordset
rs.Open sql, con, rstype, mode
End Sub

''this will generate a recordset of ur choice

6)write a sql to open recordset

dim sql as string
sql="select * from tablename"
call openrec(sql,rsname,con,adopenkeyset,adlockoptimistic)

ur rsname is ready to use

7)If u would like to show the records in textbox

text1.text=rsname.fields("field name"))

u can do it for other textbox and other controls aswell

8)to restrict user to enter numeric values
in the keypress event of text box write
 If  (KeyAscii >= 48 And KeyAscii <= 57)  
 Or KeyAscii = 8  Then
 KeyAscii = 0
 End If
 End If

to track the quantity use static variable

static intquantity as integer


while saving


******if u have any doubts ,plz gimme feedback*****
Anthony PerkinsCommented:
Here is the code I promised you:

First the instructions:
1. Create a new Project
2. Add a Text Box (txtTitles)
3. Add a Command button (cmdLookup)
4. Add a fairly wide List Box (lstTitles)
5. Add another Text Box (txtQuantity)
6. Add another Command button (cmdUpdate)

Then paste this code:

Option Explicit
Private cn As ADODB.Connection

Private Sub Form_Load()


End Sub

Private Sub cmdLookup_Click()


End Sub

Private Sub cmdUpdate_Click()


End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

Set cn = Nothing

End Sub

Private Sub Initialize()

' Set the connection
Set cn = New ADODB.Connection
With cn
   .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\My Documents\Accesswol.mdb"
End With

' Set the tabstops for the list box so the fields appear in justified columns
ReDim TabStops(0) As Long
TabStops(0) = -200      ' The negative amount right justifies.  It may need to be adjusted
SetTabStops lstTitles.hWnd, TabStops()
 Erase TabStops
 ' Intialize the quantity to be added
 txtQuantity.Text = "0"

End Sub
Private Sub Lookup()
Dim Search As String
Dim rs As ADODB.Recordset

Set rs = New ADODB.Recordset
With rs
   'Only return the first 1000 (change if not appropriate)
   .Source = "Select Top 1000 Title, Quantity From Wol"
   Search = Trim(txtTitle.Text)
   If Len(Search) Then
      .Source = .Source & " Where Title Like '" & Search & "%'"
   End If
   .Source = .Source & " Order By Title"
   .ActiveConnection = cn
   .CursorType = adOpenForwardOnly
   .LockType = adLockReadOnly
   .Open Options:=adCmdText
   Do While Not .EOF
      lstTitles.AddItem !Title & vbTab & CStr(!Quantity)
   If lstTitles.ListCount Then
      lstTitles.ListIndex = 0
      txtQuantity.Enabled = True
      cmdUpdate.Enabled = True
      txtQuantity.Enabled = False
      cmdUpdate.Enabled = False
   End If
End With
Set rs = Nothing

End Sub

Sub UpdateQuantity()
Dim AddQty As Long
Dim Pos As Integer
Dim ListItem As String
Dim Title As String
Dim Qty As Long

On Error GoTo NumErrHandler
AddQty = CLng(txtQuantity.Text)

On Error GoTo ErrHandler

ListItem = lstTitles.Text
Pos = InStr(ListItem, vbTab)
Title = Left$(ListItem, Pos - 1)
Qty = Mid$(ListItem, Pos + 1)
cn.Execute "Update wol Set Quantity = Quantity + " & AddQty & " Where Title = '" & Title & "'", , adExecuteNoRecords
lstTitles.List(lstTitles.ListIndex) = Title & vbTab & CStr(Qty + AddQty)

Exit Sub
MsgBox "Invalid Quantity:" & vbCr & txtQuantity.Text

Exit Sub
MsgBox Err.Description

End Sub

Make the necessary changes to the connection string and run.

This does not fulfill all your requirements, nor does it have all the error checking it should, but should get you on the right track.  

Let me know if you have any problems.
turnerrobAuthor Commented:
Thanks for all the trouble in the sample.,much appreciated.

I have all the form and code loaded etc.

I get an error, sub or function not defined.

SetTabStops Lsttitles.hWnd, TabStops()
It is probably a Reference or component missing in my project???? Have tried a few !!

Appreciate your advice.

Regards  Turnerrob
turnerrobAuthor Commented:
To acperkins

I have worked out the missing Module for SetTabstops.

Thankyou very much for the code, i will study it carefully and apply to my project.

Once again, much appreciated.

Thanks also for the other comments posted.

Regards  Turnerob
turnerrobAuthor Commented:
Anthony PerkinsCommented:
Sorry about that.  Here is the missing code:

Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Sub SetTabStops(hWnd As Long, TabStops() As Long)

'Clear any existing tabs
SendMessageLong hWnd, LB_SETTABSTOPS, 0&, 0&
SendMessageArray hWnd, LB_SETTABSTOPS, CLng(UBound(TabStops) - LBound(TabStops) + 1), TabStops(LBound(TabStops))

End Sub
turnerrobAuthor Commented:
Thanks, much appreciated.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now