Problems with VBA SQL to VB 1

[hpicken]

Hi folks I've looked around and can't find anytihng about this so....

I have an Access2k prog that I'm converting to VB6 DAO. In the VBA version I could do the following.

SELECT ID, Name, ListType, Register FROM tblSearchList WHERE CutSurName([Name]) LIKE 'jones*' and it would return all Names with Jones.

The function CutSurName would remove the surname from the field called name. The format of the field would be something like

"JONES, Fred James" or "JONES, Phil James AKA JONESY"

When I run this in VB6 it tells me that there is an "Undefined Function 'CutSurName' in expression".

The function is it's own module and declared public.

Anyone help me out here?

howard

 

[gmmastros]

CutSurName is the table? [Name] is the field? If so, format your sql like this.

SELECT ID, Name, ListType, Register FROM tblSearchList WHERE CutSurName.[Name] LIKE 'jones*'

-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom

 

[hpicken]

Err... no CutSurName is a function that strips the surname from the Name field.

In VBA any functions within SQL statements still get evaluated but it seems that they don't get the same treatment in VB.

H

 

[gmmastros]

Have you tried using the dbSQLPassThrough option in your OpenRecordset function?

-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom

 

[hpicken]

The sql statement works if I leave the function off e.g.

SELECT ID, Name, ListType, Register FROM tblSearchList WHERE [Name] LIKE 'jones*'

But doesn't work with ... WHERE CutSurName([Name])...

the relevant bits of code are

Private Sub ConnectIt()
    'open the database
    Set db = OpenDatabase(strPath & DBName, False, True)
End Sub

Private Sub btnSearch_Click()
    
    Call ConnectIt
    'if there is nothing to search for then exit
    If txtGetSurname.Text = "" Then Exit Sub
    Call Clear_Search
    MSFlexGrid1.BackColorSel = &HC0FFFF
    Screen.MousePointer = vbHourglass
    'make the search
    strSQL = ""
    If Not IsNull(Me!txtGetSurname) Or Not IsNull(Me!txtGetFirstName) Then
        If Me.chkSoundex Then
            Call BuildSoundexQueryCommand(Me!txtGetSurname, Me!txtGetFirstName, Me!txtlisttype)
        Else
            Call BuildQueryCommand(Me!txtGetSurname, Me!txtGetFirstName, Me!txtlisttype)
        End If
    End If

    'show the found records
    Set rsNames = db.OpenRecordset(strSQL)
    rsNames.MoveFirst
    'start at second row, leave headings alone
    MSFlexGrid1.Rows = 2
    If Not (rsNames.BOF And rsNames.EOF) Then
        Do While Not rsNames.EOF
            MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 0) = rsNames.Fields(0).Value
            MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 1) = rsNames.Fields(1).Value
            MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 2) = rsNames.Fields(2).Value
            MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 3) = rsNames.Fields(3).Value
            MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
            rsNames.MoveNext
        Loop
    End If
    
    'show number of records found
    Me.Caption = "Register List - Showing " & CStr(rsNames.RecordCount) & " records found out of " & numRecs
    'close the recordset
    strSQL = ""
    rsNames.Close
    Screen.MousePointer = vbNormal
    
End Sub

In a seperate module there is

Global strSQL As String

Public Function SoundEx(ByVal WordString As String, _
    Optional SoundExLen As Integer = 3) As String

Dim Counter As Integer
Dim CurrChar As String

If SoundExLen > 10 Then
    SoundExLen = 10
ElseIf SoundExLen < 3 Then
    SoundExLen = 3
End If
SoundExLen = SoundExLen - 1

WordString = UCase(WordString)

For Counter = 1 To Len(WordString)
    If Asc(Mid(WordString, Counter, 1)) < 65 Or _
          Asc(Mid(WordString, Counter, 1)) > 90 Then
       Mid(WordString, Counter, 1) = " "
    End If
Next Counter
WordString = Trim(WordString)

If Len(Trim(WordString)) = 0 Then
    SoundEx = ""
Else
    SoundEx = WordString
    
    SoundEx = Replace(SoundEx, "A", "0")
    SoundEx = Replace(SoundEx, "E", "0")
    SoundEx = Replace(SoundEx, "I", "0")
    SoundEx = Replace(SoundEx, "O", "0")
    SoundEx = Replace(SoundEx, "U", "0")
    SoundEx = Replace(SoundEx, "Y", "0")
    SoundEx = Replace(SoundEx, "H", "0")
    SoundEx = Replace(SoundEx, "W", "0")
    SoundEx = Replace(SoundEx, "B", "1")
    SoundEx = Replace(SoundEx, "P", "1")
    SoundEx = Replace(SoundEx, "F", "1")
    SoundEx = Replace(SoundEx, "V", "1")
    SoundEx = Replace(SoundEx, "C", "2")
    SoundEx = Replace(SoundEx, "S", "2")
    SoundEx = Replace(SoundEx, "G", "2")
    SoundEx = Replace(SoundEx, "J", "2")
    SoundEx = Replace(SoundEx, "K", "2")
    SoundEx = Replace(SoundEx, "Q", "2")
    SoundEx = Replace(SoundEx, "X", "2")
    SoundEx = Replace(SoundEx, "Z", "2")
    SoundEx = Replace(SoundEx, "D", "3")
    SoundEx = Replace(SoundEx, "T", "3")
    SoundEx = Replace(SoundEx, "L", "4")
    SoundEx = Replace(SoundEx, "M", "5")
    SoundEx = Replace(SoundEx, "N", "5")
    SoundEx = Replace(SoundEx, "R", "6")
    
    CurrChar = Left(SoundEx, 1)
    For Counter = 2 To Len(SoundEx)
        If Mid(SoundEx, Counter, 1) = CurrChar Then
            Mid(SoundEx, Counter, 1) = " "
        Else
            CurrChar = Mid(SoundEx, Counter, 1)
        End If
    Next Counter
    SoundEx = Replace(SoundEx, " ", "")
    
    SoundEx = Mid(SoundEx, 2)
    SoundEx = Replace(SoundEx, "0", "")
    
    SoundEx = SoundEx & String(SoundExLen, "0")
    SoundEx = Left(WordString, 1) & Left(SoundEx, SoundExLen)
End If

End Function

Public Function StripNonNumeric(txtInput As String) As Integer

    Dim intCounter As Integer
    Dim txtTemp As String

    For intCounter = 1 To Len(txtInput)
        Select Case Mid(txtInput, intCounter, 1)
        Case "0" To "9"
            txtTemp = txtTemp & Mid(txtInput, intCounter, 1)
        End Select
    Next
    StripNonNumeric = Trim(txtTemp)

End Function

Public Function BuildQueryCommand(tmpSurname As String, tmpFirstname As String, tmpListType As String) As String

    Dim txtFirstOp As String, txtSecondOp As String

    txtFirstOp = "LIKE"
    txtSecondOp = "LIKE"
    If Trim(tmpSurname) <> "" Then
        tmpSurname = CutSurName(tmpSurname)
    End If
    If Trim(tmpFirstname) <> "" Then
        tmpFirstname = CutOtherNames(tmpFirstname)
    End If
    
    strSQL = "SELECT ID, Name, ListType, Register FROM tblSearchList WHERE "
    If Not IsNull(tmpSurname) Then
        Call AttachAnd("Cutsurname([Name])", Chr(39) & tmpSurname, txtFirstOp, True)
        tmpFirstname = Trim(tmpFirstname)
        If Trim(tmpFirstname) <> "" Then
            Call AttachAnd("CutOtherNames([Name])", Chr(39) & "*" & tmpFirstname & Chr(39), txtSecondOp, True)
        End If
    Else
        Call AttachAnd("CutOtherNames([Name])", Chr(39) & "*" & tmpFirstname & Chr(39), txtSecondOp, True)
    End If

    tmpListType = Trim(tmpListType)
    If Trim(tmpListType) <> "" Then
        Call AttachAnd(tmpListType, Chr(39) & UCase(tmpListType) & Chr(39), "=", False)
    End If

End Function

Public Function BuildSoundexQueryCommand(tmpSurname As String, tmpFirstname As String, tmpListType As String) As String

    strSQL = "SELECT ID, Name, ListType, Register FROM tblSearchList WHERE "
    If Not IsNull(tmpSurname) Then
        Call AttachAnd("soundex(cutsurname(tmpsurname), 4)", Chr(39) & SoundEx(tmpSurname, 4) & Chr(39), "=", False)
    Else
        Call AttachAnd("soundex(cutothernames(tmpfirstname), 4)", Chr(39) & SoundEx(tmpFirstname, 4) & Chr(39), "=", False)
    End If

    If Not IsNull(tmpListType) Then
        Call AttachAnd(tmpListType, Chr(39) & tmpListType & Chr(39), "=", False)
    End If

End Function

Function AttachAnd(sField, sValue, sOperator, sWild As Boolean)

    If sValue = "''" Or sValue = "" Then
        Exit Function
    End If
    If Occurances(strSQL, "=") = 0 And Occurances(strSQL, "LIKE") = 0 Then
        strSQL = strSQL & sField & " " & sOperator & " " & sValue
    Else
        strSQL = strSQL & " AND " & sField & " " & sOperator & " " & sValue
    End If
    If sWild Then
        strSQL = strSQL & "*" & Chr(39)
    Else
        strSQL = strSQL & Chr(39)
    End If

End Function

Function Occurances(tsql, sOperator)
    Dim offset
    Dim iCount

    offset = 1
    While offset <> 0
        offset = InStr(offset + 1, tsql, sOperator)
        If offset > 1 Then
            iCount = iCount + 1
        End If
    Wend

    Occurances = iCount

End Function

and a further module which is my utilities module

Public Function CutSurName(N)
'
' CutSurName: returns the Surname (BLOGGS, Fred) in N.
'
Dim Temp, S As Integer
  Temp = Trim(N)
  If Not IsNull(Temp) Then
    S = InStr(Temp, ",")
    If S = 0 Then
      CutSurName = Temp
    Else
      CutSurName = Left(Temp, S - 1)
    End If
  End If
    
End Function

Public Function CutFirstName(N)
'
' CutFirstName: returns first name (BLOGGS, Fred Edward) in N.
'
Dim Temp, F As Integer, E As Integer, Temp2 As Variant
  Temp = Trim(N)
  If IsNull(Temp) Then
    Exit Function
  End If
  F = InStr(Temp, ",")
  If F = 0 Then
    CutFirstName = Null
  Else
    Temp2 = Trim(Mid(Temp, F + 2))
    E = InStr(Temp2, " ")
    If E = 0 Then E = 1
    CutFirstName = Mid(Temp2, 1, E - 1)
    If CutFirstName = "" Then
        CutFirstName = Temp2
    End If
  End If
  
End Function

Public Function CutOtherNames(N)
' CutOtherNames: returns all names after Surname (BLOGGS, Fred Edward) in N.
'
Dim Temp, i As Integer, OT As Integer, OTE As Integer, Temp2 As Variant
  
OT = 0
OTE = 0
Temp = Trim(N)
Temp2 = ""

OT = InStr(Temp, ", ")
OTE = InStr(Temp, " aka ")
If OTE = 0 Then
    OTE = InStr(Temp, " nee ")
End If
If OTE > 0 Then
    OTE = OTE - OT
End If
If OT = 0 Then
    CutOtherNames = Null
Else
    If OTE = 0 Then
        Temp2 = Trim(Mid(Temp, OT + 2))
    Else
        Temp2 = Trim(Mid(Temp, OT + 2, OTE - 1))
    End If
    CutOtherNames = Temp2
End If
  
End Function

I think that's all the relevant stuff. As you can see I want to more than just one small SQL statement.

Howard

 

[tony00]

Let me try to understand. On your btnSearch_Click procedue, you do something like this:

    strSQL = ""
    If Not IsNull(Me!txtGetSurname) Or Not IsNull(Me!txtGetFirstName) Then
        If Me.chkSoundex Then
            Call BuildSoundexQueryCommand(Me!txtGetSurname, Me!txtGetFirstName, Me!txtlisttype)
        Else
            Call BuildQueryCommand(Me!txtGetSurname, Me!txtGetFirstName, Me!txtlisttype)
        End If
    End If

Me (I guess) is the current form think it's the form. In this case, I think Me!txtGetSurname should be Me.txtGetSurName.

Hope this helps...

 

[hpicken]

The current form has the following fields on it.

txtGetSurname (the surname to look for)
txtGetFirstName (the firstname to look for)
chkSoundex (use soundex or not)
flexgrid1 (to display the data - later to double clck on to see the whole record)
a button called btnSearch (to start the search)
another button to clear the search (start again)

All of the code from the first box is in this form. The second is in a module called modSoundex and the third is in my modUtilities,

H

 

[hpicken]

It's 2am here so I'm off to bed. I'll check on this later tonight.

H

 

[hpicken]

I thought I would merge my two modules to see that helped but to no avail. Guess I'll keep looking

 

[SDuke]

Haven't read your code - only the initial post.
You cannot use a public funtion created in an MS ACCESS module in a "query" called from VB.
You will need to try to accomplish this using Jet VBA functions such as:

IIF(), Mid(), Left(), InStr(). etc. - however, not portable to other Dbm-systems

You should seperate the name field into two or three name fields Last, First, Middle.

 

[hpicken]

Thanks SDuke

So are your saying is that I CAN use a function within a SQL statement but it needs to be re-written in VBA?

If that's all the problem is I can handle that. If I learnt to write in VBA, I can learn to write in VB!

The code does not need to be portable so I should be right if all as above.

 

[SDuke]

>re-written in VBA

In Jet VBA! That means using a function which is available in the Jet VBA module and written directly in the sql statement, and not a function written in a VBA or VB proceedure!

Say your Name field has:
JONES, Fred James
Then you need to seach for the position of the comma, and take everything to the left of that.

So, you would need something like:

WHERE NOT [Name] IS NULL AND Left([Name],InStr([name],',')-1) LIKE 'jones%'

However, in this case you do not need to do all that as

WHERE [Name] LIKE 'jones*'

or better

WHERE [Name] LIKE 'jones*,'
adding the comma after the surname,

will find all Jones!!

(be sure to replace the asterisks with a percent sign under ADO)

 

[hpicken]

Ahhh... now it makes sense.

Although your right about the surname not needing anything, I will still need it when I search by first name and in this case the AKA name or NEE as well.

Now I have some guidence, I reckon I can work the rest out.

Thanks