Apostrophe Issue (1 Viewer)

chrisjames25

Registered User.
Local time
Today, 08:56
Joined
Dec 1, 2014
Messages
401
Hi

I have the following code in a form to check whether the string being inputted already exsits in the data:
Code:
On Error Resume Next
Dim msg, style, title, response, MyString, field, source, criteria

If Len(Me.Txt_NewTier2.Value & vbNullString) = 0 Then
 
    Else
     If DCount("Genus", "Tbl_Genus", "Genus='" & Txt_NewTier2 & "' AND Category_ID= " & Me.Cbo_Tier1) > 0 Then

  
  
       msg = "This " & StrTier22 & " already exists within the selected " & StrTier11
       style = vbOKOnly + vbExclamation
        title = StrTier2 & " Duplicate Error"

       response = MsgBox(msg, style, title)
  
    
    Me.Txt_NewTier2.Value = vbNullString
      
      '  Me.SrchText.Value = vbNullString
      
       Me.Form.Requery
  Me.Txt_NewTier2.SetFocus
   Me.Txt_ConfirmTier2.Enabled = False

Exit Sub
End If
End If

Works great until i search for a O'Neil or anything like that. The apostrophe will make it say it exists even if product doesn't.

Assume this is cos it is a delimiter symbol but not sure how to change my code to sort the issue. Cheers
 

cheekybuddha

AWF VIP
Local time
Today, 08:56
Joined
Jul 21, 2014
Messages
2,267
To deal with this you must 'escape' the single quote. This is done by doubling it:
Code:
' ...
     If DCount("Genus", "Tbl_Genus", "Genus='" & Replace(Me.Txt_NewTier2, "'", "''") & "' AND Category_ID= " & Me.Cbo_Tier1) > 0 Then
' ...

hth,

d
 

chrisjames25

Registered User.
Local time
Today, 08:56
Joined
Dec 1, 2014
Messages
401
Worked a treat. Amazing and not much tweaking to the code which is a massive bonus as only noticed this error on my tenth form so have to tweak all old ones now. THanks so much
 

cheekybuddha

AWF VIP
Local time
Today, 08:56
Joined
Jul 21, 2014
Messages
2,267
If you have to do this a lot, or build SQL strings you may wish to use a function like:
Code:
Function SQLStr(vIn As Variant, Optional blWrap As Boolean = True) As String

  Dim strRet As String
  
  If Not IsNull(vIn) Then
    strRet = Replace(vIn, "'", "''")
    If blWrap Then strRet = "'" & strRet & "'"
  Else
    strRet = "NULL"
  End If
  SQLStr = strRet
  
End Function

This will also add in the single quotes for you if you need:
Code:
' ...
     If DCount("Genus", "Tbl_Genus", "Genus=" & SQLStr(Me.Txt_NewTier2) & " AND Category_ID= " & Me.Cbo_Tier1) > 0 Then
' ...

AWF member MajP has also just posted a more all-singing, all-dancing version that handles all datatypes.

hth,

d
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 15:56
Joined
May 7, 2009
Messages
19,226
this has been long issue with single quote, how a about if the text contains a mixture of
both double quote and single quote?
this one can handle any number of single/double quote:
Code:
Option Compare Database
Option Explicit
'http://bytes.com/topic/access/answers/211263-double-quotes-data
'by: Bruce Rusk
'Usage is as follows:
'
'strSQL = "SELECT * FROM tblPeople WHERE LastName Like " & SQLQuote
'(strString) & ";"
'
'you can also have it add wildcards to modify the search by adding additional
'boolean arguments:
'
'for a wildcard before the string (search for "*endofname"):
'
'strSQL = "SELECT * FROM tblPeople WHERE LastName Like " & SQLQuote
'(strString, True) & ";"
'
'for a wildcard after the string (search for "startofname*"):
'
'strSQL = "SELECT * FROM tblPeople WHERE LastName Like " & SQLQuote
'(strString, , True) & ";"

'--------------Begin Code---------------

Const SingleQuote = "'"
Const DoubleQuote = """"
Const StarSingleQuote As String = "*'"
Const SingleQuoteStar As String = "'*"
Const DoubleQuoteStar As String = """" & "*"
Const StarDoubleQuote As String = "*" & """"
Const CHRDouble As String = "' & CHR(34) & '"
Const CHRSingle As String = "' & CHR(39) & '"

Public Function SQLQuote(ByVal strIn As Variant, _
                         Optional ByVal PrefixWildCard As Boolean = False, _
                         Optional ByVal SuffixWildcard As Boolean = False _
                       ) As String

    Dim blnSingleQuote As Boolean
    Dim blnDoubleQuote As Boolean
    Dim blnCHRStart As Boolean
    Dim blnCHREnd As Boolean
    Dim strCompare As String

    If IsDate(strIn) Then
        SQLQuote = SQLDate(strIn)
        Exit Function
    End If
    
    blnDoubleQuote = (InStr(strIn, DoubleQuote) <> 0)

    If blnDoubleQuote Then
        ' There are double quotes; check for single
        ' quotes as well

        blnSingleQuote = (InStr(strIn, SingleQuote) <> 0)

        If blnSingleQuote Then
            ' Both single AND double quotes -- complicated,
            ' replace with CHR functions

            ' Replace single quotes with CHR version
            strCompare = Replace$(strIn, SingleQuote, CHRSingle)

            ' Clean up front and back
            If Left$(strCompare, 15) = CHRSingle Then _
               strCompare = Mid$(strCompare, 5)

            If Right$(strCompare, 15) = CHRSingle Then _
               strCompare = Left$(strCompare, Len(strCompare) - 4)

            ' Replace double quotes with CHR version
            strCompare = Replace$(strCompare, DoubleQuote, CHRDouble)

            ' Clean up front and back
            If Left$(strCompare, 15) = CHRDouble Then _
               strCompare = Mid$(strCompare, 5)

            If Right$(strCompare, 15) = CHRDouble Then _
               strCompare = Left$(strCompare, Len(strCompare) - 4)

            ' String parsed, now check for wildcards

            ' First, check whether the string starts or ends with
            ' a CHR(n) value

            blnCHREnd = (StrComp(Right$(strCompare, 8), " CHR(34)")) = 0 Or _
                        (StrComp(Right$(strCompare, 8), " CHR(39)")) = 0

            blnCHRStart = Left$(strCompare, 5) = "CHR(3"

            ' Add wildcard and start/end single quotes, as
            ' needed
            '
            If PrefixWildCard Then
                If blnCHRStart Then
                    strCompare = "'*' & " & strCompare
                Else
                    strCompare = SingleQuoteStar & strCompare
                End If

            ElseIf Not blnCHRStart Then
                strCompare = SingleQuote & strCompare

            End If

            If SuffixWildcard Then

                If blnCHREnd Then
                    strCompare = strCompare & " & '*'"
                Else
                    strCompare = strCompare & StarSingleQuote
                End If

            ElseIf Not blnCHREnd Then
                strCompare = strCompare & SingleQuote

            End If

        Else
            ' Only double quotes, so using single
            ' quotes around it is safe

            If PrefixWildCard Then
                strCompare = SingleQuoteStar & strIn
            Else
                strCompare = SingleQuote & strIn
            End If

            If SuffixWildcard Then
                strCompare = strCompare & StarSingleQuote
            Else
                strCompare = strCompare & SingleQuote
            End If
        End If
    Else
        ' No double quotes in the string
        ' so using double quotes around it
        ' is safe (even if there are single
        ' quotes in it).
        '
        If PrefixWildCard Then
            strCompare = DoubleQuoteStar & strIn
        Else
            strCompare = DoubleQuote & strIn
        End If

        If SuffixWildcard Then
            strCompare = strCompare & StarDoubleQuote
        Else
            strCompare = strCompare & DoubleQuote
        End If

    End If

    SQLQuote = strCompare

End Function

'----------------End Code-------------------


Function SQLDate(varDate As Variant) As String
    'Purpose:    Return a delimited string in the date format used natively by JET SQL.
    'Argument:   A date/time value.
    'Note:       Returns just the date format if the argument has no time component,
    '                or a date/time format if it does.
    'Author:     Allen Browne. allen@allenbrowne.com, June 2006.
    If IsDate(varDate) Then
        varDate = varDate & ""
        If DateValue(CDate(varDate)) = CDate(varDate) Then
            SQLDate = Format$(varDate, "\#mm\/dd\/yyyy\#")
        Else
            SQLDate = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#")
        End If
    End If
End Function
 

cheekybuddha

AWF VIP
Local time
Today, 08:56
Joined
Jul 21, 2014
Messages
2,267
@arnelgp - nice function. 👍

However, if the textbox in @chrisjames25 example contains double quotes there will be no problem. The SQL engine will recognise them as part of the string value contained within the single quote string delimiters, and since they are not typed out in code they will not cause any problem to VBA either.
 

Micron

AWF VIP
Local time
Today, 03:56
Joined
Oct 20, 2018
Messages
3,478
only noticed this error on my tenth form
Hmmm, does that mean you have 10 (or more) forms that do pretty much the same thing? Perhaps they exist because of different criteria such as dates, names, departments or the like? That would not be the way to do things because forms should be flexible or dynamic so that this doesn't happen.
 

HalloweenWeed

Member
Local time
Today, 03:56
Joined
Apr 8, 2020
Messages
213
I made some functions to deal with this:
Code:
Public Function RmvPunct(InputStr As Variant, Optional StopAtComma As Variant) As Variant
'....................................................................
' This simple function removes punctuation, and other non-alphanumeric
'  non-numeric characters, but leaves spaces.
' The result is a string of only alphanumeric and numeric characters.
' Note that commas are removed, as are both types of slashes, dashes ("-"),
'  asterisks ("*"), underscores, "<", and ">".
' The result is designed to be used with CompareLikeWithoutPunct().
' Note that care should be taken (filter) in the calling routine to
'  insure that the variant attempted to be passed is
'  actually a string, any other variant type will throw an error.
' If Optional StopAtComma = True or -1 then the result string will be
'  truncated at the comma (excluding).
' Other StopAtComma values are ignored.
' If the search string is not type "string" then function returns Null.
'....................................................................

On Error GoTo Err_Handler

Dim WkgStr As Variant, WkgChar As Long
Dim Index As Long, StrLen As Long
Dim SaC As Boolean

    If VarType(InputStr) <> vbString Then
        WkgStr = Null
        GoTo ExitFunction
    End If

'convert Variant to Boolean
    SaC = False                                     'convert null Variant to False
    If IsMissing(StopAtComma) Then GoTo Jump
    If VarType(StopAtComma) = vbBoolean Then SaC = StopAtComma
    If VarType(StopAtComma) > 1 And VarType(AddQuarters) < 6 Then
                                'type Integer, Long, Single, or Double number
        If StopAtComma = -1 Then SaC = True
    End If

Jump:
    WkgStr = ""
    InputStr = Trim(InputStr)
    StrLen = Len(InputStr)
    If StrLen < 1 Then GoTo ExitFunction
    Index = 1

    Do While Index <= StrLen
        WkgChar = Asc(Mid(InputStr, Index, 1))
'If WkgChar is comma (",") and StopAtComma commanded then stop and do not continue to add characters
        If WkgChar = 44 And SaC Then Exit Do

        Select Case WkgChar

        Case 32:
            'Case: space (" ")
            WkgStr = WkgStr & Mid(InputStr, Index, 1)

        Case 48 To 57:
            'Case: numeric character
            WkgStr = WkgStr & Mid(InputStr, Index, 1)

        Case 65 To 90:
            'Case: alphanumeric character uppercase
            WkgStr = WkgStr & Mid(InputStr, Index, 1)

        Case 97 To 122:
            'Case: alphanumeric character lowercase
            WkgStr = WkgStr & Mid(InputStr, Index, 1)

        End Select
        Index = Index + 1
    Loop

ExitFunction:
    RmvPunct = WkgStr
    Exit Function

Err_Handler:
    MsgBox ("Error #" & Err.Number & ": " & Err.Description)
    Resume ExitFunction

End Function

Code:
Public Function RmvPunctAndSpaces(InputStr As Variant, Optional StopAtComma As Variant) As Variant
'....................................................................
' This simple function removes spaces, punctuation, and other non-alphanumeric
'  non-numeric characters.
' The result is a string of only alphanumeric and numeric characters.
' Note that commas are removed, as are both types of slashes, dashes ("-"),
'  asterisks ("*"), underscores, "<", and ">".
' The result is designed to be used with CompareLikeWithoutPunct().
' Note that care should be taken (filter) in the calling routine to
'  insure that the variant attempted to be passed is
'  actually a string, any other variant type will throw an error.
' If Optional StopAtComma = -1 or True then the result string will be truncated at
' the comma (excluding). Other StopAtComma values are ignored.
' If the search string is not type "string" then function returns Null.
'....................................................................

On Error GoTo Err_Handler

Dim WkgStr As Variant, WkgChar As Long
Dim Index As Long, StrLen As Long

    If VarType(InputStr) <> vbString Then
        WkgStr = Null
        GoTo ExitFunction
    End If
    WkgStr = ""
    InputStr = Trim(InputStr)
    StrLen = Len(InputStr)
    If StrLen < 1 Then GoTo ExitFunction
    Index = 1

    Do While Index <= StrLen
        WkgChar = Asc(Mid(InputStr, Index, 1))
'If WkgChar is comma (",") and StopAtComma commanded then stop and do not continue to add characters
        If WkgChar = 44 And StopAtComma = -1 Then Exit Do

        Select Case WkgChar

        Case 48 To 57:
            'Case: numeric character
            WkgStr = WkgStr & Mid(InputStr, Index, 1)

        Case 65 To 90:
            'Case: alphanumeric character uppercase
            WkgStr = WkgStr & Mid(InputStr, Index, 1)

        Case 97 To 122:
            'Case: alphanumeric character lowercase
            WkgStr = WkgStr & Mid(InputStr, Index, 1)

        End Select
        Index = Index + 1
    Loop

ExitFunction:
    RmvPunctAndSpaces = WkgStr
    Exit Function

Err_Handler:
    MsgBox ("Error #" & Err.Number & ": " & Err.Description)
    Resume ExitFunction

End Function

Code:
Public Function CompareLikeWithoutPunct(Optional FrstStr As Variant, _
                Optional ScndStr As Variant, Optional StopAtComma As Long) As Boolean
'....................................................................
' Name: CompareLikeWithoutPunct
' Inputs: Optional FrstStr As Variant, Optional ScndStr As Variant, Optional StopAtComma As Long
' Designed for two string-type inputs, but compatible with nulls and missing variables.
' Option: StopAtComma (Long) = -1 (True) causes the compare to end at the comma
'  (after stripping non-alpha, non-numeric chars); Then only compare the results beginning with the
'  short result string (the long string is truncated for comparison of the left chars only,
'  length is string is insignificant). This means that when using this option, only the alpha- and
'  numeric chars to the left of the comma are used, and matched with only the same number of
'  alpha- and numeric chars in the other string.
' Returns: Boolean logic (True if match)
' Dependancy: RmvPunctAndSpaces()
' Author: HalloweenWeed
' Date: 10/11/2019
' Compares strings without counting non-alphanumeric characters but does compare numeric characters too.
' If one string is null, will return false unless the other string is also null.
' If both strings are missing this will evaluate true.
' Note that if boolean-type variants are given, it will evaluate true if both are boolean,
'  otherwise false.
' Other non-string variant types (such as numeric or date for instance) will
'  evaluate true if both are the exact same variant type, otherwise false, regardless of the values.
'....................................................................

On Error GoTo Err_Handler

Dim FrstCmprStr As String, ScndCmprStr As String
Dim Index As Long, FrstCmprLen As Long, ScndCmprLen As Long
Dim Result As Boolean

    Result = False

'Begin type checking to prevent runtime errors
    If IsMissing(FrstStr) And IsMissing(ScndStr) Then
        Result = True
        GoTo ExitFunction
    End If
    If IsMissing(FrstStr) Or IsMissing(ScndStr) Then
        GoTo ExitFunction
    End If
    If IsNull(FrstStr) And IsNull(ScndStr) Then
        Result = True
        GoTo ExitFunction
    End If
    If IsNull(FrstStr) Or IsNull(ScndStr) Then
        GoTo ExitFunction
    End If

    If VarType(FrstStr) = vbString And VarType(ScndStr) = vbString Then
'Strip the non-alpha non-numeric characters out (if both are type String)
        FrstCmprStr = RmvPunctAndSpaces(Trim(FrstStr), StopAtComma)
        ScndCmprStr = RmvPunctAndSpaces(Trim(ScndStr), StopAtComma)
        FrstCmprLen = Len(FrstCmprStr)
        ScndCmprLen = Len(ScndCmprStr)
        If FrstCmprLen = 0 And ScndCmprLen = 0 Then
            Result = True
            GoTo ExitFunction
        End If
        If FrstCmprLen = 0 Or ScndCmprLen = 0 Then
            Result = False
            GoTo ExitFunction
        End If

'If StopAtComma = True (-1) then make both strings the same length (truncate long string) before comparing
        If Not IsMissing(StopAtComma) Then
            If FrstCmprLen < ScndCmprLen Then
                ScndCmprStr = Left(ScndCmprStr, FrstCmprLen)
                ScndCmprLen = Len(ScndCmprStr)
            Else
                If FrstCmprLen > ScndCmprLen Then
                    FrstCmprStr = Left(FrstCmprStr, ScndCmprLen)
                    FrstCmprLen = Len(FrstCmprStr)
                End If
            End If
        End If

'If strings are unequal length, compare fails and we are done
        If FrstCmprLen <> ScndCmprLen Then
            Result = False
            GoTo ExitFunction
        End If

        If FrstCmprStr Like ScndCmprStr Then
            Result = True
            GoTo ExitFunction
        End If

    Else
'If variants passed are not string nor null, then if types are equal return true
        If VarType(FrstStr) = VarType(ScndStr) Then
            Result = True
            GoTo ExitFunction
        Else
            Result = False
        End If
    End If

ExitFunction:
    CompareLikeWithoutPunct = Result
    Exit Function

Err_Handler:
    MsgBox ("Error #" & Err.Number & ": " & Err.Description)
    Resume ExitFunction

End Function

Then it works like this:
Code:
If RmvPunct(InputStr) Like RmvPunct(SecondStr) Then...

-OR-

Code:
If CompareLikeWithoutPunct(FirstStr, SecondStr) Then...

Might be overkill, but covers a lot of possibilities, and gives me more control over the results.
 

Users who are viewing this thread

Top Bottom