Oppure

Loading
10/07/09 14:08
Ture_70
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:
Option Explicit
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim stringa As String


Per inserire i dati nel database uso:
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?
aaa
10/07/09 15:32
GrG
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...
aaa
10/07/09 17:21
Louis
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:
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:
' 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:
aaa
10/07/09 23:05
Ture_70
Stò a poco a poco modificando parte del codice..ecco quello che ho scritto fino ad ora:
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 è
rs.Open , cn, adOpenDynamic, adLockOptimistic


(grazie per l' aiuto sia a te che a GrG)
aaa
11/07/09 6:55
Louis
Ciao,
evidenzia l'errore perché non hai aperto la connessione, come peraltro ti avevo già indicato:

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


aaa
11/07/09 7:08
Ture_70
E ora mi segna errore in
 .open 


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

modulo bas:
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:
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:
aaa
11/07/09 10:54
Louis
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 11/07/09 11:21
aaa
11/07/09 13:07
Ture_70
Ho ovviato al problema scrivendo la stringa (la stessa uguale identica presente nel modulo bas in .ConnectionString quindi ho:
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:
rs.Open , cn, adOpenDynamic, adLockOptimistic


Dice che manca un operatore....
aaa