array controle werkt niet

[phobia]

ik heb een functie die moet kijken of een string in een array staat.
Maar ik krijg hem niet werkend.

Orgineel zou deze regel:
Public Function in_array(needle As String, haystack() As String) As Boolean

Dit moeten zijn:
Public Function in_array(needle As String, haystack() As Variant) As Boolean


Zou iemand er eens voor mij naar willen kijken?

Option Compare Database

Private Sub opdracht_Change()
Dim dbMyDB As Database
Dim rsMyRS As Recordset
Dim TextInput As String
Dim OutPut As String
Dim TestArray() As String
Dim OutArray() As String

Dim i As Integer

 TextInput = Me.opdracht.Text
 
 TestArray = Split(TextInput, " ")
 
 GetDBPath = CurrentProject.Path & "\"
 Set dbMyDB = OpenDatabase(GetDBPath + "Ex_Essilor.accdb")
 Set rsMyRS = dbMyDB.OpenRecordset("questions", dbOpenDynaset)
 
 If TextInput <> "" Then
    If UBound(TestArray) > 0 Then
            For i = LBound(TestArray) To UBound(TestArray)
                If i = 0 Then
                    OutPut = "omschrijving LIKE %" + TestArray(i) + "%"
                Else
                    If TestArray(i) <> "" Then
                        OutPut = OutPut + " omschrijving LIKE %" + TestArray(i) + "%"
                    End If
                End If
            Next i
        Else
            OutPut = "omschrijving LIKE %" + TestArray(0) + "%"
    End If
End If

If TextInput <> "" Then
Me.gevonden.Visible = True
If Not rsMyRS.EOF Then rsMyRS.MoveFirst
Do While Not rsMyRS.EOF
    If (in_array(rsMyRS!omschrijving, OutArray()) = False) Then
        OutArray(UBound(OutArray)) = rsMyRS!omschrijving
        ReDim Preserve OutArray(0 To UBound(OutArray) + 1) As String
    End If
    rsMyRS.MoveNext
Loop

    For i = LBound(OutArray) To UBound(OutArray)
        Me.gevonden.AddItem OutArray(i)
    Next i

Else

    Me.gevonden.Visible = False

End If

End Sub

Public Function in_array(needle As String, haystack() As String) As Boolean
    Dim i As Integer, ret As Boolean
    ret = False
   
    If UBound(haystack) > 0 Then
        For i = LBound(haystack) To UBound(haystack)
            If haystack(i) = needle Then ret = True
        Next i
    End If
    in_array = ret
End Function

 

[edmoor]

Volgens mij mist er een Exit For onder If haystack(i) = needle Then ret = True maar dat zou op zich geen probleem moeten zijn.

 

[phobia]

het probleem is volgens mij ook alleen als er nog nix in de array zit.
daarom wil ik controleren of de array leeg is.
maar daar loopt hij dan op een bug

deze regel
If UBound(haystack) > 0 Then

 

[edmoor]

Je bedoeld denk ik dat hij dan een foutmelding geeft?
En welke melding is dat dan?

 

[phobia]

ik ben al een heel eind op geschoten.
Maar krijg ik de data niet in de array
Dim OutArray() As Variant
OutArray(0) = rsMyRS!omschrijving

Dit is de hele functie:

Private Sub opdracht_Change()
Dim dbMyDB As Database
Dim rsMyRS As Recordset
Dim TextInput As String
Dim OutPut As String
Dim TestArray() As String
Dim OutArray() As Variant

Dim i As Integer
 TextInput = Me.opdracht.Text
 
 TestArray = Split(TextInput, " ")
 
 GetDBPath = CurrentProject.Path & "\"
 Set dbMyDB = OpenDatabase(GetDBPath + "Ex_Essilor.accdb")
 Set rsMyRS = dbMyDB.OpenRecordset("questions", dbOpenDynaset)

If TextInput <> "" Then
Me.gevonden.Visible = True
If Not rsMyRS.EOF Then rsMyRS.MoveFirst
Do While Not rsMyRS.EOF
    If IsNull(OutArray) = True Then
        If (in_array(rsMyRS!omschrijving, OutArray) = False) Then
            OutArray(UBound(OutArray)) = rsMyRS!omschrijving
            ReDim Preserve OutArray(0 To UBound(OutArray) + 1) As Variant
        End If
    Else
        ReDim OutArray(0, 0)
        
        OutArray(0) = rsMyRS!omschrijving
        ReDim Preserve OutArray(0 To UBound(OutArray) + 1) As Variant
    End If
    rsMyRS.MoveNext
        
Loop

    For i = LBound(OutArray) To UBound(OutArray)
        Me.gevonden.AddItem OutArray(i)
    Next i

Else

    Me.gevonden.Visible = False

End If

End Sub

 

[snb]

Stort je eerst op de beginselen. Daarna de toepassing.

Sub snb()
  Dim sn()
    
  ReDim Preserve sn(12)
  sn(0) = "tekst0"
  sn(1) = "tekst1"
  sn(2) = "tekst2"
    
  x = Application.Match("tekst0", sn, 0)
  y = Application.Match("tekst1", sn, 0)
  z = Application.Match("tekst2", sn, 0)

  aa = Application.Match("tekst9", sn, 0)

  If IsError(Application.Match("tekst9", sn, 0)) Then sn(Application.CountA(sn) - 1) = "tekst9"
End Sub