مساعدة في استعلام البحث عن كلمة داخل جملة

[elazaizy2030]

السلام عليكم 

المرفق هو البحث بكلمة داخل جمله  ولكن يوجد مشكلة في ظهور الرسالة 

محتاج مساعدة في عدم ظهور الرسالة المرفقة في نتيجة الاستلام وان يكون نتيجة #ERROR  هي (عدم وجود المطلوب) 

re.accdb

[محمد احمد لطفى]

تفضل بالتوفيق 

 

DoCmd.SetWarnings False
'On Error GoTo errhld:

Dim Arr() As String
Dim i As Long
Arr = Split(Str)

FnSearch = "عدم وجود المطلوب" ' القيمة الافتراضية إذا لم يتم العثور على شيء

  For i = 0 To UBound(Arr)
    If i + 8 <= UBound(Arr) Then
        If Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & " " & Trim(Arr(i + 3)) & " " & Trim(Arr(i + 4)) & " " & Trim(Arr(i + 5)) & " " & Trim(Arr(i + 6)) & " " & Trim(Arr(i + 7)) & " " & Trim(Arr(i + 8)) & "'"), 0) <> 0 Then
            FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & " " & Trim(Arr(i + 3)) & " " & Trim(Arr(i + 4)) & "'")
            Exit For
        End If
    End If
    
    If i + 3 <= UBound(Arr) Then
        If Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & " " & Trim(Arr(i + 3)) & "'"), 0) <> 0 Then
            FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & " " & Trim(Arr(i + 3)) & "'")
            Exit For
        End If
    End If
    
    If i + 2 <= UBound(Arr) Then
        If Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & "'"), 0) <> 0 Then
            FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & "'")
            Exit For
        End If
    End If
    
    If i + 1 <= UBound(Arr) Then
        If Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & "'"), 0) <> 0 Then
            FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & "'")
            Exit For
        End If
    End If
    
    If i <= UBound(Arr) Then
        If Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & "'"), 0) <> 0 Then
            FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & "'")
            Exit For
        End If
    End If
 Next i

errhld = Nz(DLookup("KindX", "TableX", "[NameX] Like '" & SetName & "'"), "غير مسجل")