Option
Explicit
Const
QuellDatei
As
String
=
"Z:\Forum\Kundenstam.xlsx"
Const
QuellTabelle =
"[Kunde$A:P]"
Const
SuchSpalte
As
Long
= 4
Private
Sub
TextBox1_AfterUpdate()
Dim
oDateisatz
As
Object
Dim
Verbindung
As
String
Dim
Abfrage
As
String
Dim
Vorgabe
As
String
Dim
x
As
Integer
Dim
y
As
Integer
Verbindung =
"Provider=Microsoft.ACE.OLEDB.12.0;"
& _
"Data Source="
& QuellDatei &
";"
& _
"Extended Properties="
"Excel 12.0 Xml;HDR=YES;IMEX=1"
""
Abfrage =
"SELECT * FROM "
& QuellTabelle
Vorgabe =
"= 'Wert'"
On
Error
GoTo
errorhandler
Set
oDateisatz = CreateObject(
"ADODB.Recordset"
)
oDateisatz.Open Abfrage, Verbindung, 0, 1, 1
If
Not
oDateisatz.EOF
Then
Vorgabe = Replace(Vorgabe,
"Wert"
,
Me
.TextBox1.Text)
oDateisatz.Filter = oDateisatz.Fields(SuchSpalte).Name & Vorgabe
On
Error
GoTo
0
On
Error
Resume
Next
For
x = 0
To
oDateisatz().Count
y = x + 1
Me
(y).Caption =
""
Me
(y).Caption = oDateisatz(x).Value
Next
x
Else
Me
.TextBox1.Text =
"nicht gefunden"
Me
.TextBox1.SetFocus
End
If
oDateisatz.Close
Set
oDateisatz =
Nothing
On
Error
GoTo
0
Exit
Sub
errorhandler:
On
Error
GoTo
0
On
Error
Resume
Next
Set
oDateisatz =
Nothing
MsgBox
"Verbindungsfehler"
On
Error
GoTo
0
End
Sub