_InStrLike

Public Function InStrLike(Optional ByVal Start, Optional ByVal String1, Optional ByVal String2, Optional ByVal intCompareMethod As VbCompareMethod = vbTextCompare) As Variant
On Error GoTo err_InStrLike
 Dim intPos As Integer
 Dim intLength As Integer
 Dim strBuffer As String
 Dim blnFound As Boolean
 Dim varReturn As Variant
 If Not IsNumeric(Start) And IsMissing(String2) Then
 String2 = String1
 String1 = Start
 Start = 1
 End If
 If IsNull(String1) Or IsNull(String2) Then
 varReturn = Null
 GoTo exit_InStrLike
 End If
 If Left(String2, 1) = "*" Then
 err.Raise vbObjectError + 2600, "InStrLike", "Comparison mask cannot start with '*' since a start position cannot be determined."
 Exit Function
 End If
 For intPos = Start To Len(String1) - Len(String2) + 1
 If InStr(1, String2, "*", vbTextCompare) Then
  For intLength = 1 To Len(String1) - intPos + 1
  strBuffer = Mid(String1, intPos, intLength)
  If strBuffer Like String2 Then
   blnFound = True
   GoTo done
  End If
  Next intLength
 Else
  strBuffer = Mid(String1, intPos, Len(String2))
  If strBuffer Like String2 Then
  blnFound = True
  GoTo done
  End If
 End If
 Next intPos
done:
 
 If blnFound = False Then
 varReturn = 0
 Else
 varReturn = intPos
 End If
exit_InStrLike:
 InStrLike = varReturn
 Exit Function
err_InStrLike:
 Select Case err.Number
 Case Else
  varReturn = Null
  MsgBox err.Description, vbCritical, "Error #" & err.Number & " (InStrLike)"
  GoTo exit_InStrLike
 End Select
End Function