Creating sql string for vba query with wildcard characters

Fordraiders
Fordraiders used Ask the Experts™
on
Excel 2010 vba

I'm taking a text string from a cell
Splitting that into an array.

The code works fine UNLESS i only have one Token.  i.e.   FLAPPER  OR  VALVE

I'm creating the end of the "WHERE" clause in my sql statement.

for ONE word,   two word and/or  three word strings.


    lk = "Like"
    lm = " WwgCore.RICHTEXT "
    
    cD = Trim(cD)
    cD = Replace(cD, "  ", " ")
    cD = Replace(cD, ",", " ")
    cD = Replace(cD, "#", "")
    cD = Replace(cD, """", "")

    ' how many items are in the cell ?  build an array
            
    nF1 = cD
            
    cArrSql = Split(nF1, " ")
            
    ' search through the cell requests tokens.
    For x = LBound(cArrSql) To UBound(cArrSql)
        If x = UBound(cArrSql) Then
            nF1 = Trim(nF1 & " " & Chr(34) & "%" & cArrSql(x) & "%" & Chr(34))
               
        Else
            If x = 0 Then
                nF1 = Trim(Chr(34) & "%" & cArrSql(x) & "%" & Chr(34) & " AND" & lm & lk & " ")
            
            Else
                nF1 = Trim(nF1 & " " & Chr(34) & "%" & cArrSql(x) & "%" & Chr(34) & " AND" & lm & lk & " ")
            
            End If
        End If
    Next

    rng2 = nf1

Open in new window


The end of my WHERE clause is:
strsql = strsql & "WHERE WwgCore.RICHTEXT LIKE " & rng2 & ";"

for 2 tokens the string looks like this :
rng2 =   "%FLAPPER%" AND WwgCore.RICHTEXT Like "%VALVE%"  and the code works fine

ultimately nf1 for One Word token should be passed as  "%FLAPPER%"

per above example:

But does not work for ONE word tokens

Thanks
fordraiders
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Bill PrewIT / Software Engineering Consultant
Top Expert 2016

Commented:
If you debug the code, and watch or display strsql after you build it, what does it show as. before it doesn't work?

~bp

Author

Commented:
with 2 tokens that work.

"%FLAPPER%" AND WwgCore.RICHTEXT Like "%VALVE%";
Top Expert 2014

Commented:
It would help the experts if you posted some example inputs to this code snippet.
CompTIA Network+

Prepare for the CompTIA Network+ exam by learning how to troubleshoot, configure, and manage both wired and wireless networks.

IT / Software Engineering Consultant
Top Expert 2016
Commented:
You problem stems from the boundary condition where UBound = LBound.  This occurs when only one word is being parsed, and the logic fails.

I rewrote the logic to work better I think, and it will handle that case and the multiwords as well.  See if this makes sense and if it works better.  The WHERE clause is now entirely generated by the function, so notice the concatenation to the base SQL is slightly different.  I also like to do the quoting in a function, easier to read later I think.

rng2 = BuildWhere("FLAPPER")
strsql = strsql & rng2 & ";"

Function BuildWhere(cD As String)

    lk = "Like"
    lm = "WwgCore.RICHTEXT"
 
    cD = Trim(cD)
    cD = Replace(cD, "  ", " ")
    cD = Replace(cD, ",", " ")
    cD = Replace(cD, "#", "")
    cD = Replace(cD, """", "")
 
    ' how many items are in the cell ?  build an array
    cArrSql = Split(cD, " ")
        
    ' search through the cell requests tokens.
    For x = LBound(cArrSql) To UBound(cArrSql)
        If x = LBound(cArrSql) Then
            nf1 = "WHERE " & lm & " Like " & Quote("%" & cArrSql(x) & "%")
        Else
            nf1 = nf1 & " AND " & lm & " Like " & Quote("%" & cArrSql(x) & "%")
        End If
    Next
 
    BuildWhere = nf1
 
End Function

Function Quote(strText As String)
    Quote = Chr(34) & strText & Chr(34)
End Function

Open in new window

~bp
Top Expert 2014

Commented:
Here is a different approach.
Notes:

* Force explicit variable declaration (best practices)
* Use Regexp object to do the cleaning and parsing
* Retain Bill's Quote() function
* Use Join() function to add the " AND " strings
* Return a valid Where clause if nothing parsed
Option Explicit

Sub Q_28926419()
    Dim rng2, strsql
    rng2 = BuildWhere("FLAPPER ""234"" #$@@ buzzkill")
    strsql = strsql & rng2 & ";"
    Debug.Print strsql
End Sub


Function BuildWhere(ByVal cD As String)
    Const lmlk = "WwgCore.RICHTEXT Like "
    Dim cArrSql() As String
    
    Static oRE As Object
    Dim oMatches As Object
    Dim oM As Object
    Dim lngSM As Long

    If oRE Is Nothing Then
        Set oRE = CreateObject("vbscript.regexp")
        oRE.Global = True
        oRE.Pattern = "[0-9A-Za-z]+"
    End If

    If oRE.test(cD) Then
        Set oMatches = oRE.Execute(cD)
        ReDim cArrSql(1 To oMatches.Count)
        lngSM = 1
        For Each oM In oMatches
            cArrSql(lngSM) = lmlk & Quote("%" & oM.Value & "%")
            lngSM = lngSM + 1
        Next
    Else
        BuildWhere = "WHERE 0=1"
    End If

    BuildWhere = "WHERE " & Join(cArrSql, " AND ")
 
End Function

Function Quote(ByVal strText As String)
    Quote = Chr(34) & strText & Chr(34)
End Function

Open in new window

Top Expert 2014
Commented:
You can also iterate the matches numerically.
Option Explicit

Sub Q_28926419()
    Dim rng2, strsql
    rng2 = BuildWhere("FLAPPER ""234"" #$@@ buzzkill")
    strsql = strsql & rng2 & ";"
    Debug.Print strsql
End Sub


Function BuildWhere(ByVal cD As String)
    Const lmlk = "WwgCore.RICHTEXT Like "
    Dim cArrSql() As String
    
    Static oRE As Object
    Dim oMatches As Object
    Dim lngM As Long

    If oRE Is Nothing Then
        Set oRE = CreateObject("vbscript.regexp")
        oRE.Global = True
        oRE.Pattern = "[0-9A-Za-z]+"
    End If

    If oRE.test(cD) Then
        Set oMatches = oRE.Execute(cD)
        ReDim cArrSql(0 To oMatches.Count - 1)
        For lngM = 0 To oMatches.Count - 1
            cArrSql(lngM) = lmlk & Quote("%" & oMatches(lngM).Value & "%")
        Next
    Else
        BuildWhere = "WHERE 0=1"
    End If

    BuildWhere = "WHERE " & Join(cArrSql, " AND ")
 
End Function

Function Quote(ByVal strText As String)
    Quote = Chr(34) & strText & Chr(34)
End Function

Open in new window

Author

Commented:
Thanks Guys, As always great help !!
Bill PrewIT / Software Engineering Consultant
Top Expert 2016

Commented:
Welcome.

~bp

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial