Prepare for the CompTIA Network+ exam by learning how to troubleshoot, configure, and manage both wired and wireless networks.
Creating sql string for vba query with wildcard characters
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.
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
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
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
Do more with
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
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
~bp
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.
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
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
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
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
Premium Content
You need an Expert Office subscription to comment.Start Free Trial