Listbox schnell mit vielen Einträgen füllen

Hallo VBA-Profis,
ich suche eine Möglichkeit, eine Listbox sehr schnell mit vielen Einträgen zu füllen.
Hintergrund: Ich habe in einer Userform eine TextBox1. Bei jeder Änderung der TextBox1 möchte ich, dass ListBox1 geleert und dann mit allen Einträgen %like% TextBox1 gefüllt wird.
Die Einträge kommen aus einer Access Datenbank.
Momentan funktioniert es so:


Sub Listbox_SQL(mySql As String)
On Error GoTo hell
Dim t
t = Timer
Const pfad As String = "C:\Pfad"          'Access DB PFad
Const myAccessDB As String = "MyAccDB.mdb"                'Access DB Dateiname
Const APPNAME = "mod_Access / Gefilter_laden_SQL"
'ACCESS Tabelle per SQL Kommando filtern und gefilterte laden
Dim cmd As ADODB.Command
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim spalte As Long
Debug.Print "DIM after: " & Timer - t
Set con = New ADODB.Connection
con.Open ConnectionString:= _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & pfad & "\" & myAccessDB & ";" & _
"Mode=Share Exclusive"
Set cmd = New ADODB.Command
cmd.ActiveConnection = con
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseServer
'rs.Index = "Primarykey"
Debug.Print "SET Con after: " & Timer - t
rs.Open mySql, _
ActiveConnection:=con, _
CursorType:=adOpenStatic, _
LockType:=adLockPessimistic, _
Options:=adCmdTableDirect
Debug.Print "RS after: " & Timer - t
UF_Wahl.ListBox1.Clear
If Not rs.BOF Or rs.EOF Then
rs.MoveFirst
Do While Not rs.EOF
UF_Wahl.ListBox1.AddItem rs.Fields(0).Value
rs.MoveNext
Loop
End If
Debug.Print "Listbox after: " & Timer - t
'*** Fehlerbehandlung
hell:
If Err.Number = -2147467259 Then Resume     'Datenbank wird bereits verwendet
Err.Clear
Set cmd = Nothing
con.Close
Set con = Nothing
End Sub
Private Sub TextBox_Model_Change()
Call Listbox_SQL("Select Tier from Tierreich as mytab where [mytab.Tier] like '%" & UF_Wahl. _
TextBox_Model & "%'")
End Sub
'DIM after: 0
'SET Con after: 0,125
'RS after: 0,4375
'Listbox after: 1,109375

Wie ihr seht, dauert das füllen der Listbox (es sind etwas über 1000 Einträge) über 0,6 sekunden. Das klingt wenig, ist aber extrem störend wenn in TextBox1 getippt wird.
Gibt es eine Möglichkeit, die Listbox schneller und möglichst ohne Schleife komplett zu füllen? Bis dahin behelfe ich mir damit, das Makro auf "TextBox1_Exit" statt "_change" zu legen, finde es aber nur halb so elegant.
LG,
Klaus M.

Luschi,
Öffnen / Schließen der ADOB Connection in Initialise und Close zu verlagern ist eine gute Idee - das ist auf jedem Fall sauberer. Ich habe überhaupt nicht darüber nachgedacht und ganz Script-Kiddie mäßig das vorhanden SQL-Script kopiert und benutzt wie es ist.
Aber es wird nicht helfen - die Recordsets laden dauert ja nur eine zehntel Sekunde, das langsame an dem ganzen Vorgang ist die Schleife zum befüllen der Listbox. Ich warte aber ganz geduldig auf dein Array-Script :-)
Offtopic: Ich benutze die ADOB-Connection Makros eigentlich immer so:

sub hochladen()
for i = 1 to 1000
call AccessMakro(i)
next i
end sub
sub Accesmakro(i as long)
recordset erstellen
rs!eintrag = cells(i,1).value
recordset schließen
end sub

Also Adob auf / zu / auf / zu und das tausend mal. Ist trotzdem rasend schnell! Wenn es deutlich mehr als 5000 Einträge werden, nehme ich aber ein optimiertes Makro.
LG,
Klaus M.

Listbox schnell mit vielen Einträgen füllen

Forumthread: Listbox schnell mit vielen Einträgen füllen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial