> It looks like a good piece of code! Your going to have to get it out of
VB
> and into C++ or Delphi or something of the like so that you can make it
> into a compiled .DLL or ActiveX control.
> VB is good glue for sticking things together but you can't do any real
> processing with it.
> -cliff-
> > subject: access-vba-code for comparing two strings?
> > Hi folks,
> > As an access developer I often need to search for data
> > without knowing the exact spelling. So I am working
> > on a function that compares two strings. The more
> > the two strings match the higher the function's
> > return value will be.
> > The function below works pretty well. But with large amounts
> > of data it's too slow for my application.
> > Has anyone an idea for a faster running function having
> > a similar result?
> > Greetings Josef
> > '-------------------------------------------------------------------
> > '--- modul for MS-Access97: version 1997/08/20
> > '-------------------------------------------------------------------
> > Option Compare Database
> > Option Explicit
> > Function compare(var_text_a As Variant, var_text_b As Variant) As
Single
> > '--- compares two strings and returns a value between 0 and 1000
> > '--- (0 = no match, 1000 = complete match)
> > '--- if str_text_a and str_text_b are swapped, the same value
should
> be
> > returned
> > Dim str_text_a As String, str_text_b As String
> > '--- exit if NULL
> > If IsNull(var_text_a) Or IsNull(var_text_b) Then compare = 0: Exit
> > Function
> > '--- transform into strings
> > str_text_a = var_text_a
> > str_text_b = var_text_b
> > Dim int_i As Integer, int_j As Integer
> > Dim int_limit As Integer, int_pos As Integer
> > '--- initialize
> > Dim int_try As Integer, int_hit As Integer
> > int_try = 0
> > int_hit = 0
> > '--- trim blanks
> > str_text_a = Trim$(str_text_a)
> > str_text_b = Trim$(str_text_b)
> > '--- swap if LEN(str_text_b) > LEN(str_text_a)
> > '--- this accelerates the function
> > Dim str_help As String
> > If Len(str_text_a) > Len(str_text_b) Then
> > str_help = str_text_b
> > str_text_b = str_text_a
> > str_text_a = str_help
> > End If
> > '--- exit if empty
> > If str_text_a = "" Or IsNull(str_text_a) Then compare = 0: Exit
> > Function
> > '--- store character count in variables
> > '--- this accelerates the function
> > Dim int_len_a As Integer, int_len_b As Integer
> > int_len_a = Len(str_text_a)
> > int_len_b = Len(str_text_b)
> > Dim str_part As String
> > '--- compare parts of the string with LIKE
> > '--- exit if already wildcards
> > If str_text_a = "?" Or str_text_a = "*" Then compare = 0:
> Exit
> > Function
> > '--- string length too short
> > If int_len_a <= 1 Then compare = 0: Exit Function
> > '--- str_text_a equal str_text_b?
> > If InStr(str_text_b, str_text_a) <> 0 Then compare = 1000 -
> > (int_len_b - int_len_a): Exit Function
> > '--- wildcard parts of str_text_a
> > '--- test with LIKE
> > '--- example "test"
> > '--- *test*, *tes**, *te*t*, *te***, *t*st*, *t*s**,
*t**t*,
> > *t****
> > '--- **est*, **es**, **e*t*, **e***, ***st*, ***s**,
****t*,
> > ******
> > str_text_a = "*" & str_text_a & "*"
> > int_limit = 2 ^ (int_len_a - 1)
> > For int_i = 0 To 2 ^ int_len_a - 1
> > str_ part = str_text_a
> > int_j = 1
> > int_pos = 2
> > Do While int_j <= int_limit
> > If int_j And int_i Then Mid$(str_ part, int_pos, 1)
=
> > "*"
> > int_j = int_j * 2
> > int_pos = int_pos + 1
> > Loop
> > int_try = int_try + 1
> > If str_text_b Like str_ part Then int_hit = int_hit + 1
> > Next int_i
> > '--- calculate return value
> > '--- reduce value if strings have different length
> > compare = int_hit / int_try * 1000 - (int_len_b -
int_len_a)
> > If compare < 0 Then compare = 0
> > End Function
access-vba-code for comparing two strings?