Hi,
Another point to consider is the practically of the design intent.
No matter how long it takes to load it, no user is going to want to
manipulate their way through that many lines in a list box.
Think of an alternative action for when you don't find the required data.
--
Regards
Laurie Comerford
"Jon Fleming" wrote in message
news:5817999@discussion.autodesk.com...
Maybe this is more of a connectivity issue after all!
I haven't analyzed it in detail, but two points:
1. It looks as if you are using DAO. That has been obsolescent (not
obsolete) for several years. ActiveX Data Objects (ADO) is its replacement,
and is much more full-featured and likely to be faster. It's also much
easier and simpler to use.
2. It looks as if you are grabbing the whole table into a recordset then
using your SQL string to repeatedly query that recordset. If I'm right then
that's very inefficient. The database driver is heavily optimized for
retrieval, so it should be doing that job rather than having VBA do it, and
you only need to apply the SQL once, and you don't need to retrieve all the
columns. Here's an example of doing it with ADO:
Dim oConn As ADODB.Connection
Dim oRS As ADODB.Recordset
Set oConn = New ADODB.Connection
Set oRS = New ADODB.Recordset
oConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;persist
security info=false"
oConn.Open "C:\AtttribDB\sifrant.mdb"
Dim sqlString As String
Dim i As Long
Dim effNameSplit As Variant
effNameSplit = Split(effName)
' Note the change in the SQL statement
sqlString = "Select Koda, opis, Dobavitelj from Artikli where Naziv
LIKE '*" & effNameSplit(i) & "*' OR NazivDob LIKE '*" & effNameSplit(i) &
"*' OR Opis LIKE '*" & effNameSplit(i) & "*'"
i = 1
If i < UBound(effNameSplit) Then
Do
sqlString = sqlString & "OR Naziv LIKE '*" & effNameSplit(i) &
"*' OR NazivDob LIKE '*" & effNameSplit(i) & "*' OR Opis LIKE '*" &
effNameSplit(i) & "*'"
i = i + 1
Loop Until UBound(effNameSplit)
End If
' Back into the new stuff
oRS.Open sqlString, oConn
' Now you have a recordset of zero or more length, containing
' only records that match your SQL statement.
' Do a MoveLast then MoveFirst to populate the size before querying it
' If it's zero length then you can grab the whole table with
' oRS.Close then
' oRS.Open "Select "Select Koda, opis, Dobavitelj from Artikli", oConn
.
.
.
oRS = Nothing
oConn.Close
oConn = Nothing
--
jrf
Autodesk Discussion Group Facilitator
Please do not email questions unless you wish to hire my services
On Thu, 10 Jan 2008 19:02:49 +0000, gregri wrote:
> Well, here's the code, if anyone can find lines that can be trimmed:
>
> Private Sub UserForm_Initialize()
>
> If effName = "" Then
> MsgBox "Invalid block name" & vbNewLine & "all database entries
will be shown."
> effName = "*"
> End If
>
>
> Set baza =
DBEngine.Workspaces(0).OpenDatabase("C:\AtttribDB\sifrant.mdb")
> Set recset = baza.OpenRecordset("Artikli", dbOpenDynaset)
>
> Dim sqlString As String
> Dim i As Long
> Dim effNameSplit As Variant
> effNameSplit = Split(effName)
> sqlString = "Naziv LIKE '*" & effNameSplit(i) & "*' OR NazivDob LIKE
'*" & effNameSplit(i) & "*' OR Opis LIKE '*" & effNameSplit(i) & "*'"
> i = 1
> If i < UBound(effNameSplit) Then
> Do
> sqlString = sqlString & "OR Naziv LIKE '*" & effNameSplit(i)
& "*' OR NazivDob LIKE '*" & effNameSplit(i) & "*' OR Opis LIKE '*" &
effNameSplit(i) & "*'"
> i = i + 1
> Loop Until UBound(effNameSplit)
> End If
> recset.FindFirst sqlString
> i = 0
>
> If recset.NoMatch = True Then
> MsgBox "Inserted element does not match any database entries;" &
vbNewLine & "all database entries will be shown."
> recset.MoveFirst
> Do
> recset.MoveNext
> If recset.EOF = True Then
> Exit Do
> Else
> i = i + 1
> End If
> Loop
> ' THIS DO-LOOP IS QUITE FAST (SUB 1 SECOND)
> ReDim listPos(i) As Long
> i = 0
> recset.MoveFirst
> Dim dbcount As Long
> dbcount = 0
> Do Until recset.EOF = True
> lbxNaziv.AddItem (recset!Naziv)
> listPos(i) = recset.AbsolutePosition
> recset.MoveNext
> dbcount = dbcount + 1
> i = i + 1
> Loop
> 'THIS ONE IS THE CULPRIT
> recset.MoveFirst
> txtGovkoda = recset!Koda
> txtOpis = recset!opis
> txtProizvajalec = recset!Dobavitelj
>
> Else
> Do
> recset.FindNext sqlString
> If recset.NoMatch = True Then
> Exit Do
> Else
> i = i + 1
> End If
> Loop
> ReDim listPos(i) As Long
> i = 0
> recset.FindFirst sqlString
> lbxNaziv.Clear
> txtGovkoda = recset!Koda
> txtOpis = recset!opis
> txtProizvajalec = recset!Dobavitelj
> Do
> lbxNaziv.AddItem (recset!Naziv)
> listPos(i) = recset.AbsolutePosition
> i = i + 1
> recset.FindNext sqlString
> If recset.NoMatch = True Then
> Exit Do
> End If
> Loop
> effName = ""
> End If
>
> txtFind.SetFocus
>
> End Sub
>
>
>
> I've translated a few of the strings, but some of the variables will be
confusing to English speakers. Just think, database, Manufacturer,
ProductCode,....
