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