Newsgroup: it.comp.appl.access
Titolo: Federico Luciani & soundex help!

Un ciao a tutto il N.G.,
nella sezione "generale" del Sito Comune ho trovato un db di esempio
per l'utilizzo dell'algoritmo soundex, scritto da Federico Luciani.
Potete scaricare l'esempio a questo link: 
http://www.mclink.it/personal/MC5884/
.
Mi sembra che funzioni molto bene, ma quello che mi piacerebbe facesse
anche è la possibilità di selezionare i comuni che ho trovato dopo la
ricerca.
Cioè come modifico il codice in modo che la casella di testo
"txtEsito" diventi un ListBox così poi posso selezionare con il mouse
quello che voglio e magari con un doppio click sulla selezione far
aprire la maschera corrispondente al record a cui si riferisce il
comune trovato.
Questo è il codice che sta dietro la maschera:
******start code******
Option Compare Database
Option Explicit
Private pavfonDiscard ' parole da non fonetizzare
Private Sub cmdEsci_Click()
    On Error GoTo Err_cmdEsci_Click
    DoCmd.Close
Exit_cmdEsci_Click:
    Exit Sub
Err_cmdEsci_Click:
    MsgBox Err.Description
    Resume Exit_cmdEsci_Click
End Sub
'Private Sub cmdInfo_Click()
    'MsgBox "Fonte: Edizioni Infomedia" & vbCrLf & _
            '"Autore modulo principale: Nicola Martella" & vbCrLf & _
            '"Autore esempio in MSAccess: Federico Luciani", _
            'vbInformation + vbOKOnly, "Information"
'End Sub
Private Sub cmdSoundex_Click()
   Dim l As Long
   If Not IsNull(Me.txtSentence) Then
        txtSoundex = fonIndexMemo(txtSentence, l)
        txtParole = "Parole fonetizzate: " & l
   End If
End Sub
Private Sub cmdCercaComune_Click()
    Dim dbs As Database
    Dim rst As Recordset
    Dim strSQL As String
    Dim strMsg As String
    Dim strCerca As String
    Dim l As Long
    Set dbs = CurrentDb()
    If IsNull(Me.txtComune) Then GoTo esci
    strCerca = fonIndexMemo(NoSpace(Me.txtComune), l)
    strSQL = "SELECT tblCave.* " & _
             "From tblCave " & _
             "Where (((tblCave.CodSoundex) = '" & strCerca & "')) " &
_
             "ORDER BY tblCave.Nome_cava;"
    Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
    strMsg = Me.txtComune & " (" & strCerca & ")"
    If rst.EOF And rst.BOF Then
        strMsg = "Non trovato!"
        rst.Close
        GoTo esci
    End If
    rst.MoveFirst
    With rst
        Do
            strMsg = strMsg & vbCrLf & ![Nome_cava]
            .MoveNext
        Loop Until rst.EOF
        .Close
    End With
esci:
    Me.txtEsito = strMsg
    Set dbs = Nothing
End Sub
Private Sub cmdCreaCodComuni_Click()
    Dim dbs As Database
    Dim rst As Recordset
    Dim l As Long
    If MsgBox("Crea i codici Soundex (a 4 digit) per i comuni." &
vbCrLf & _
                "Potrebbe impiegarci alcuni minuti, continuare?", _
                vbYesNo + vbQuestion, "Attenzione") = vbNo Then Exit
Sub
    DoCmd.Hourglass True
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset("tblCave", dbOpenDynaset)
    rst.MoveFirst
    With rst
    Do
        .Edit
        ![CodSoundex] = fonIndexMemo(NoSpace(rst![Nome_cava]), l)
        .Update
        .MoveNext
    Loop Until rst.EOF
    .Close
    End With
    Set dbs = Nothing
    DoCmd.Hourglass False
End Sub
Private Sub Form_Load()
   Me.Caption = "Soundex sample"
   ' parole da non fonetizzare
   pavfonDiscard = Array("IL", "LO", "LA", "GLI", "LE", "MA", _
                         "UN", "UNO", "UNA", _
                         "AL", "AI", "ALLO", "ALLA", "ALLE", "AGLI", _
                         "DEL", "DEGLI", "DEI", "DI", "DA", _
                         "IN", "CON", "SU", "PER", "TRA", "FRA")
End Sub
'\*
Private Function fonIndexMemo(sSentence As String, lCount As Long) As
String
' LIBRERIA::      ROUTINE DI SUPPORTO ALLA FONETIZZAZIONE
' MODULO::        fonIndexMemo()
' INCLUDE::
' REALIZZATO IL:: 02/05/1997
' AGGIORNATO IL::
' AUTORE::        Nicola Martella
' SCOPO::         Flusso per la fonetizzazione personalizzabile a
seconda delle necessità.
'                 Si pone come interfaccia alla libreria SoundexLib
'
-------------------------------------------------------------------------
' PARAMETRI:: string (sSentence) - Frase da fonetizzare
'             long (lCount) - Parole fonetizzate
' RITORNA::   string (fonIndexMemo) - Concatenazione degli indici
fonetici relativi alla
'                                     frase passata
'*\
   Dim avWords    ' parole da fonetizzare
   Dim l As Long
   Dim sSoundex As String
   Dim sWord As String
   Dim bEmpty As Boolean
   Dim sWords As String
   If Len(sSentence) = 0 Then Exit Function
   sWords = sSentence
   ' escludo i caratteri ascii <32
   sWords = ChangeInSpaceControlChars(sWords)
   ' carico le parole da fonetizzare
   avWords = StrToArr(UCase(sWords), " ", bEmpty)
   ' scarto le parole da non fonetizzare
   avWords = fonDiscard(avWords, bEmpty)
   If Not bEmpty Then Exit Function
   ' codifica
   For l = LBound(avWords) To UBound(avWords)
      sWord = avWords(l)
      ' COMMENTARE IL PROSSIMO STATEMENT SE NON SI VUOLE
      ' IGNORARE LA PAROLA A DESTRA DEL CARATTERE APICE.
      ' gestisco le parole con un'apice all'interno.
      ' Es: all'epoca diventa epoca
      sWord = fonApici(sWord)
      ' elimina i caratteri in testa alla parola diversi da lettere e
numeri fino al primo
      ' carattere valido eventualmente convertendolo da lettera
accentata ad equivalente
      ' non accentato
      sWord = fonNormalizzaWords(sWord)
      ' fonetizzo la parola e la concateno in un'unica stringa di
indici
      sSoundex = sSoundex & fSoundex(sWord, lCount)
   Next
   fonIndexMemo = sSoundex
End Function
'\*
Private Function fonNormalizzaWords(ByVal sWord As String) As String
' LIBRERIA::      ROUTINE DI SUPPORTO ALLA FONETIZZAZIONE
' MODULO::        fonNormalizzaWords()
' INCLUDE::
' REALIZZATO IL:: 02/05/1997
' AGGIORNATO IL::
' AUTORE::        Nicola Martella
' SCOPO::         Normalizza la parola da fonetizzare.
' Se il carattere è:
' > una lettera accentata - viene convertita nell'equivalente non
accentato.
' > un numero - in un #
' > un qualunque carattere diverso da lettere e numeri - viene
ignorato
'
-------------------------------------------------------------------------
' PARAMETRI:: string (sWord) - Parola da normalizzare
' RITORNA::   string (fonNormalizzaWords) - Parola normalizzata
'*\
   Dim i As Integer
   Dim sChar As String
   For i = 1 To Len(sWord)
      Select Case Asc(Mid$(sWord, i, 1))
         Case 65 To 90  ' lettere
            sChar = Mid$(sWord, i, 1)
         Case 48 To 57  ' numeri
            sChar = "#"
         Case 192 To 198, 224 To 230
            sChar = "A"
         Case 199, 231
            sChar = "C"
         Case 200 To 203, 232 To 235
            sChar = "E"
         Case 204 To 207, 236 To 239
            sChar = "I"
         Case 208, 240
            sChar = "D"
         Case 209, 241
            sChar = "N"
         Case 201 To 214, 242 To 246
            sChar = "O"
         Case 216 To 220, 247 To 252
            sChar = "U"
         Case 221, 225
            sChar = "Y"
         Case Else
            sChar = " "
      End Select
      Mid$(sWord, i, 1) = sChar
      sChar = ""
   Next
   fonNormalizzaWords = NoSpace(sWord)
End Function
'\*
Private Function fonDiscard(avSource, bIsEmpty As Boolean) As Variant
' LIBRERIA::      ROUTINE DI SUPPORTO ALLA FONETIZZAZIONE
' MODULO::        fonDiscard()
' INCLUDE::
' REALIZZATO IL:: 02/05/1997
' AGGIORNATO IL::
' AUTORE::        Nicola Martella
' SCOPO::         Filtra l'array passato togliendo le parole non
fonetizzabili.
'                 Si appoggia all'array pavfonDiscard
'
-------------------------------------------------------------------------
' PARAMETRI:: array variant (avSource) - Parola che potrebbe contenere
apici
'             boolean (bIsEmpty) - True se l'array ritornato da
fonDiscard() contiene
'                                  elementi
' RITORNA::   variant (fonDiscard) - array con le sole parole
fonetizzabili
'*\
   Dim l As Long
   Dim j As Long
   Dim lt As Long
   Dim sSource As String
   Dim lNumSource As Long
   Dim bDiscard As Boolean
   Dim asTemp() As String
   lNumSource = UBound(avSource)
   ReDim asTemp(lNumSource)
   lt = -1
   For l = LBound(avSource) To lNumSource
      sSource = avSource(l)
      For j = 0 To UBound(pavfonDiscard)
         If sSource = pavfonDiscard(j) Then
            bDiscard = True
            Exit For
         End If
      Next
      If Not bDiscard Then
         If Len(sSource) > 1 Then   ' scarto le parole di un carattere
            If Not IsNumeric(sSource) Then   ' scarto le parole di
numeri
               lt = lt + 1
               asTemp(lt) = sSource
            End If
         End If
      End If
      bDiscard = False
   Next
   If lt = -1 Then Exit Function
   bIsEmpty = True
   ReDim Preserve asTemp(lt)
   fonDiscard = asTemp
End Function
'\*
Private Function fonApici(ByVal sWord As String) As String
' LIBRERIA::      ROUTINE DI SUPPORTO ALLA FONETIZZAZIONE
' MODULO::        fonApici()
' INCLUDE::
' REALIZZATO IL:: 02/05/1997
' AGGIORNATO IL::
' AUTORE::        Nicola Martella
' SCOPO::         Elimina i caratteri a sinistra dell'eventuale apice,
apice compreso,
'                 e conserva i caratteri a destra dell'apice
'
-------------------------------------------------------------------------
' PARAMETRI:: string (sWord) - Parola che potrebbe contenere apici
' RITORNA::   string (fonApici) - Parola senz'apici
'*\
   Dim p As Integer
   p = InStr(sWord, "'")
   If p > 0 Then
      If p < Len(sWord) Then
         sWord = Mid$(sWord, p + 1)
      End If
   End If
   fonApici = sWord
End Function
******end code******
Spero di essere stato chiaro,
Ringrazio chiunque voglia aiutarmi...
Un salutone,
Stefano.

 Stefano.
Dipende dall'output; la stringa di ritorno è delimitata da un carattere? Se 
sì puoi utilizzare la funzione Split e ogni item creato (dalla funzione 
Split) puoi farlo diventare un item della list/combobox...
Ciao.
-- 
Sergio MAZZA 

 wrote:

Ciao Sergio,
ma dove devo agire precisamente? su questa parte del codice?
Il fatto è che non sono molto bravo nello scrivere codici.... mi
potresti aiutare?
********

************
Ciao Stefano.

 ha scritto nel messaggio 
news:ae65c752-9cae-4f3b...@i12g2000prf.googlegroups.com...
Ciao Sergio,
ma dove devo agire precisamente? su questa parte del codice?
Il fatto è che non sono molto bravo nello scrivere codici.... mi
potresti aiutare?
[risposta]
Non capisco; come fai a dire che funziona?
La stai utilizzando?
---omissis---
Ciao Stefano.
[risposta]
Ciao.
-- 
Sergio MAZZA 

 ha scritto nel messaggionews:ae65c752-9cae-4f3b...@i12g2000prf.googlegroups.com...

No, non lo sto utilizzando, volevo solo chiederti se dovevo cambiare
quella Sub.
Non so come si fa...
Ciao!

 ha scritto nel messaggio 
news:d44c7901-72c1-4579...@e23g2000prf.googlegroups.com...
No, non lo sto utilizzando, volevo solo chiederti se dovevo cambiare
quella Sub.
Non so come si fa...
Ciao!
[risposta]
Prima la implementi; poi provi e a secondo di cosa restituisce, operiamo.
Ti dico questo perché io non la utilizzo...
Ciao.
-- 
Sergio MAZZA