Visual Basic 6 - Cercare record in database

Forum - Visual Basic 6 - Cercare record in database

Pagine: [ 1 2 ]

Ture_70 (Normal User)
Rookie

Messaggi: 30
Iscritto: 25/01/2009

Postato alle 16:08
Venerdì, 10/07/2009

Salve a tutti, stò creando un programma come per la gestione di una videoteca (il tipico programma per far pratica) e non riesco a cercare nel database. Scendo subito nel codice, ecco quello che utilizzo per connettermi al database:

Codice sorgente - presumibilmente VB.NET

Option Explicit
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim stringa As String

Per inserire i dati nel database uso:

Codice sorgente - presumibilmente VB.NET

dim stringa as String
stringa = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
    stringa = stringa & "C:\Users\utente\Desktop\videoteca.mdb"
 
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
 
    cn.Open stringa
    rs.Open "Campeggiatori", cn, 3, 3
 
    rs.AddNew
        rs("Nome") = txtNome.Text
        rs("Autore") = txtAutore.Text
        rs("Anno") = txtAnno.Text

La connessione e l' inserimento dei dati avviene con successo.

Ora, stò creando un' altra form con 3 textbox (TxtCerca e TxtAutore, TxtAnno) e 1 pulsante (CmdCerca).
Vorrei inserire il titolo nel TxtCerca, premere il CmdCerca e vedere nel TxtAutore e TxtAnno, l' autore e l' anno del film cercato (tramite il nome). Non ho idea di come fare, potreste aiutarmi?

GrG (Member)
Guru^2

Messaggi: 3430
Iscritto: 21/08/2007

Postato alle 17:32
Venerdì, 10/07/2009

la query dovrebbe essere: SELECT autore, anno FROM tuo_db WHERE titolo = 'tuo titolo';

Mi spiace ma non ho mai lavorato con db da vb6 quindi non so come prelevare il risultato...

Louis (Normal User)
Pro

Messaggi: 150
Iscritto: 22/04/2008

Postato alle 19:21
Venerdì, 10/07/2009

Ciao Turi,
prima di tutto ti consiglio di fare la connessione con Il DB in un modulo bas con una variabile globale, in modo che apri la con. e rs quando ti serve e subito dopo chiudi tutto. Quindi in un modulo bas:

Codice sorgente - presumibilmente VB.NET

Public DataConnessione As String
'-------------------------------
Public Sub DataConnessione2()
    On Error GoTo ErrHandler
' Stringa di connessione Senza password:
    DataConnessione = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\TuoNomeDB.mdb;Persist Security Info=False;"
' Stringa di connessione Con password:
    'DataConnessione = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\TuoNomeDB.mdb;Persist Security Info=False;Jet OLEDB:Database Password=TuaPassWord;"
 
ErrHandler:
    If Err.Number <> 0 Then
        MsgBox "Errore: " & Err.Number & " " & Err.Description & Chr(13) _
        & "Errore  nella connessione al Data Base." & Chr(13) _
        & "Riavviare il programma.", vbCritical, "......"
        Err.Clear
        Exit Sub
    End If
End Sub

Poi, per brevità, utilizzo un frammento di codice di un prog. già predisposto, che tu renderai compatibile con il tuo elaborato. La ricerca del cliente avviene prima per nome e cognome e poi per il solo cognome, nel caso in cui il nome non fosse registrato:
Quindi sempre in un modulo bas:

Codice sorgente - presumibilmente VB.NET

' Cerca i dati anagrafici di un cliente:
Public Sub CercaDatiCliente()
    
    Dim Ogg5 As New ADODB.Command
    Dim Cns5 As New ADODB.Connection
    Dim RST5 As New ADODB.Recordset
    Dim intDomCerca As Integer
    
    'Esegue la connessione con il DataBase TblAnagCliente (Tabella del DB):
        With Cns5
            .ConnectionString = DataConnessione 'Questa è la stringa di connessione del DB
            .CursorLocation = adUseClient       'tipo di cursore
            .Mode = adModeShareDenyNone         'nessuna limitazione
            .CommandTimeout = 15
            .Open
        End With
 
' Controlla che il Cliente Sia inserito già nel BD:
    ' Selezione con il Nome e Cognome:
    If Len(sNomeCL) > 0 And Len(sCognomrCL) > 0 Then
        RST5.Source = "SELECT Nome, Cognome FROM TblAnagCliente WHERE Nome='" & Replace(sNomeCL, "'", "''") & "' And Cognome='" & Replace(sCognomrCL, "'", "''") & "'"
        RST5.Open , Cns5, adOpenDynamic, adLockOptimistic
        ' Selezione con il solo Cognome:
        ElseIf Len(sNomeCL) = 0 And Len(sCognomrCL) > 0 Then
        RST5.Source = "SELECT Nome, Cognome FROM TblAnagCliente WHERE Cognome='" & Replace(sCognomrCL, "'", "''") & "'"
        RST5.Open , Cns5, adOpenDynamic, adLockOptimistic
    End If
    
    ' Il Cliente è presente nel DB:
        If RST5.EOF = False And RST5.BOF = False Then
            MsgBox "Il cliente:" & Space(1) & sNomeCL & Space(1) & sCognomrCL & Chr(13) _
            & "è già registrato nel database." & Chr(13) _
            & "Di seguito sono esposti i dati registrati.", vbInformation + vbOKOnly, "......."
            
            ' Chiude il RecordSet
            RST5.Close
            ' Visualizza la FrmAnCliMod:
            FrmAnCliMod.Show
    
    ' Visualizza i dati contenuti nel DB - FrmAnCliMod - per eventuali modifiche:
        ' Selezione con il Nome e Cognome:
        If Len(sNomeCL) > 0 And Len(sCognomrCL) > 0 Then
            RST5.Source = "SELECT Titolo, Nome, Cognome, CodFisc, Via, NomeVia, Ncivico, Cap, Citta, Provincia, Telefono, Cellulare, Fax, Email FROM TblAnagCliente WHERE Nome='" & Replace(sNomeCL, "'", "''") & "' And Cognome='" & Replace(sCognomrCL, "'", "''") & "'"
            RST5.Open , Cns5, adOpenDynamic, adLockOptimistic
            ' Selezione con il solo Cognome:
            ElseIf Len(sNomeCL) = 0 And Len(sCognomrCL) > 0 Then
            RST5.Source = "SELECT Titolo, Nome, Cognome, CodFisc, Via, NomeVia, Ncivico, Cap, Citta, Provincia, Telefono, Cellulare, Fax, Email FROM TblAnagCliente WHERE Cognome='" & Replace(sCognomrCL, "'", "''") & "'"
            RST5.Open , Cns5, adOpenDynamic, adLockOptimistic
        End If
            FrmAnCliMod.TxtCt0m.Text = RST5("Titolo")
            FrmAnCliMod.TxtCt1m.Text = RST5("Nome")
            FrmAnCliMod.TxtCt2m.Text = RST5("Cognome")
            FrmAnCliMod.TxtCt3m.Text = RST5("CodFisc")
            FrmAnCliMod.TxtCt4mb.Text = RST5("Via")
            FrmAnCliMod.TxtCt4m.Text = RST5("NomeVia")
            FrmAnCliMod.TxtCt5m.Text = RST5("Ncivico")
            FrmAnCliMod.TxtCt6m.Text = RST5("Cap")
            FrmAnCliMod.TxtCt7m.Text = RST5("Citta")
            FrmAnCliMod.TxtCt7mb.Text = RST5("Provincia")
            FrmAnCliMod.TxtCt8m.Text = RST5("Telefono")
            FrmAnCliMod.TxtCt9m.Text = RST5("Cellulare")
            FrmAnCliMod.TxtCt10m.Text = RST5("Fax")
            FrmAnCliMod.TxtCt11m.Text = RST5("Email")
                
            'Chiude e cancella il recordSet:
            If GetState(RST5.State) = "adStateOpen" Then
                RST5.Close
                Set RST5 = Nothing
            End If
            'Chiude la connessione:
            If GetState(Cns5.State) = "adStateOpen" Then
                Cns5.Close
                Set Cns5 = Nothing
            End If
            Exit Sub
        End If
    
        If RST5.EOF = True And RST5.BOF = True Then
            ' Il Cliente Non è presente nel DB, viene inserito:
            intDomCerca = MsgBox("Il cliente:" & Space(1) & sNomeCL & Space(1) & sCognomrCL & Chr(13) _
            & "non è ancora registrato, volete procedere alla registrazione?" & Chr(13) _
            & "Click su OK per registrare, su Annulla per chiudere il modulo.", vbInformation + vbOKCancel, "....")
            ' Pulsante OK:
            If intDomCerca = 1 Then
                ' Visualizza la FrmAnagCliente:
                FrmAnagCliente.Show
            End If
        End If
 
'Chiude e cancella il recordSet:
    If GetState(RST5.State) = "adStateOpen" Then
        RST5.Close
        Set RST5 = Nothing
    End If
'Chiude la connessione:
    If GetState(Cns5.State) = "adStateOpen" Then
        Cns5.Close
        Set Cns5 = Nothing
    End If
 
End Sub

Come vedi è importante chiudere la connessione ed eliminare il rs in quanto utilizzano molte risorse e poi se non fai la procedura predetta quando esci dal prog. potrebbero sorgere difficoltà.
Spero che ti sia utile.
:k:

Ture_70 (Normal User)
Rookie

Messaggi: 30
Iscritto: 25/01/2009

Postato alle 1:05
Sabato, 11/07/2009

Stò a poco a poco modificando parte del codice..ecco quello che ho scritto fino ad ora:

Codice sorgente - presumibilmente VB.NET

Option Explicit
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim stringa As String
 
Private Sub Command1_Click()
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
    
    
If txtCerca = "" Then
   MsgBox "Inserisci il numero del documento da cercare.", vbCritical, "ERRORE"
ElseIf txtCerca.Text <> "" Then
   rs.Source = "Select Titolo from Video where Titolo = txtCerca.Text"
   rs.Open , cn, adOpenDynamic, adLockOptimistic
End If
 
Set cn = Nothing
Set rs = Nothing
End Sub

Però all' esecuzione mi dice:
"Connessione chiusa o non valida in questo contesto. Impossibile utilizzarla per eseguire l' operazione."

e la riga che in cui senga l' errore è

Codice sorgente - presumibilmente Plain Text

rs.Open , cn, adOpenDynamic, adLockOptimistic

(grazie per l' aiuto sia a te che a GrG)

Louis (Normal User)
Pro

Messaggi: 150
Iscritto: 22/04/2008

Postato alle 8:55
Sabato, 11/07/2009

Ciao,
evidenzia l'errore perché non hai aperto la connessione, come peraltro ti avevo già indicato:

Codice sorgente - presumibilmente VB.NET

Option Explicit
Private Sub Command1_Click()
    
    Dim Cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    
    'Esegue la connessione con il DataBase:
     With Cn
        .ConnectionString = DataConnessione     'Questa è la stringa di connessione del DB
        .CursorLocation = adUseClient           'Questo é il tipo di cursore
        .Mode = adModeShareDenyNone             'Nessuna limitazione
        .CommandTimeout = 15
        .Open
    End With
         
    If Len(txtCerca) = 0 Then
       MsgBox "Inserisci il numero del documento da cercare.", vbCritical, "ERRORE"
    ElseIf Len(txtCerca.Text) > 0 Then
       rs.Source = "Select Titolo FROM Video WHERE Titolo='" & Replace(txtCerca.Text, "'", "''") & "'"
       rs.Open , Cn, adOpenDynamic, adLockOptimistic
    End If
    
    'Chiude e cancella:
        If Cn.state = adStateOpen Then
            Cn.Close
            Set Cn = Nothing
            rs.Close
            Set rs = Nothing
        End If
End Sub

Ture_70 (Normal User)
Rookie

Messaggi: 30
Iscritto: 25/01/2009

Postato alle 9:08
Sabato, 11/07/2009

E ora mi segna errore in

Codice sorgente - presumibilmente Plain Text

.open

Scusami per la negligenza, comunqe....ecco cosa ho messo:

modulo bas:

Codice sorgente - presumibilmente VB.NET

Public DataConnessione As String
 
Public Sub DataConnessione2()
    On Error GoTo ErrHandler
    DataConnessione = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\Users\utente\Desktop\Video.mdb;Persist Security Info=False;"
 
ErrHandler:
    If Err.Number <> 0 Then
        MsgBox "Errore: " & Err.Number & " " & Err.Description & Chr(13) _
        & "Errore  nella connessione al Data Base." & Chr(13) _
        & "Riavviare il programma.", vbCritical, "......"
        Err.Clear
        Exit Sub
    End If
End Sub

Nella form di ricerca:

Codice sorgente - presumibilmente VB.NET

Option Explicit
Private Sub Command1_Click()
     
    Dim Cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
     
    'Esegue la connessione con il DataBase:
     With Cn
        .ConnectionString = DataConnessione     'Questa è la stringa di connessione del DB
        .CursorLocation = adUseClient           'Questo é il tipo di cursore
        .Mode = adModeShareDenyNone             'Nessuna limitazione
        .CommandTimeout = 15
        .Open
    End With
         
    If Len(txtCerca) = 0 Then
       MsgBox "Inserisci il titolo da cercare.", vbCritical, "ERRORE"
    ElseIf Len(txtCerca.Text) > 0 Then
       rs.Source = "Select Documento Numero FROM Campeggiatori WHERE Documento Numero ='" & Replace(txtCerca.Text, "'", "''") & "'"
       rs.Open , Cn, adOpenDynamic, adLockOptimistic
    End If
     
    'Chiude e cancella:
        If Cn.State = adStateOpen Then
            Cn.Close
            Set Cn = Nothing
            rs.Close
            Set rs = Nothing
        End If
End Sub

Segna errore in .open
grazie ancora :hail:

Louis (Normal User)
Pro

Messaggi: 150
Iscritto: 22/04/2008

Postato alle 12:54
Sabato, 11/07/2009

Ciao,
capisci che senza aver sotto mano il DB é difficile seguirti. Prova a mettere un punto d'interruzione su Public Sub DataConnessione2() in modo tale da seguire con F8 (passo a passo) tutta la procedura sino al punto d'errore; Visto che non apre la connessione forse c'é quancosa nella Sub predetta.

Ultima modifica effettuata da Louis il 11/07/2009 alle 13:21

Ture_70 (Normal User)
Rookie

Messaggi: 30
Iscritto: 25/01/2009

Postato alle 15:07
Sabato, 11/07/2009

Ho ovviato al problema scrivendo la stringa (la stessa uguale identica presente nel modulo bas in .ConnectionString quindi ho:

Codice sorgente - presumibilmente Delphi

With cn
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\Users\utente\Desktop\video.mdb"           'Questa è la stringa di connessione del DB
        .CursorLocation = adUseClient           'Questo é il tipo di cursore
        .Mode = adModeShareDenyNone             'Nessuna limitazione
        .CommandTimeout = 15
        .Open
    End With
         
    If Len(txtCerca) = 0 Then
       MsgBox "Inserisci il titolo da cercare.", vbCritical, "ERRORE"
    ElseIf Len(txtCerca.Text) > 0 Then
       rs.Source = "Select Titolo FROM Video WHERE Titolo ='" & Replace(txtCerca.Text, "'", "''") & "'"
       rs.Open , cn, adOpenDynamic, adLockOptimistic
    End If

La connessione visto che non da errori ritengo vada in porto, però ora mi da un errore qui:

Codice sorgente - presumibilmente Plain Text

rs.Open , cn, adOpenDynamic, adLockOptimistic

Dice che manca un operatore....

Louis (Normal User)
Pro

Messaggi: 150
Iscritto: 22/04/2008

Postato alle 20:49
Sabato, 11/07/2009

Codice sorgente - presumibilmente VB.NET

If Len(txtCerca) = 0 Then
    MsgBox "Inserisci il titolo da cercare.", vbCritical, "ERRORE"
    ElseIf Len(txtCerca.Text) > 0 Then
    rs.Source = "Select Titolo FROM Video WHERE Titolo='" & Replace(txtCerca.Text, "'", "''") & "'"
    rs.Open , cn, adOpenDynamic, adLockOptimistic
End If

E' molto strano, a mio avviso non apri la connessione.
Per individuare il nome delle tabelle del DB ti consiglio di nominarle con Tbl, cioé TblVideo così é immediata la differenza tra i Nomi dei Campi e quelli delle Tbl.
Per quanto riguarda il non funzionamento della stringa di connessione hai provato a fare come ti ho detto per individuare l'errore ?

Ultima modifica effettuata da Louis il 11/07/2009 alle 20:53

Pagine: [ 1 2 ]