[VBA/ACCESS] Ricerca record

[defra]

Ciao a tutti.
Sto provando a inserire un record nuovo solo se non già presete, ma mi da qualche errore...mi aiutate?


Private Sub Comando6_Click()

Dim RS As Recordset

' apre la tabella
Set RS = CurrentDb.OpenRecordset("ANNO1")

' Cerca il record

RS.Index = "ID_PAZIENTI"
RS.Seek "=", Me!ID_PAZIENTI

If RS!ID_PAZIENTI = Me!ID_PAZIENTI Then
MsgBox "Attenzione codice già esistente"

Else
RS.AddNew
RS!ID_PAZIENTI = Me!ID_PAZIENTI
RS.Update

End If

RS.Close

' aggiorna la form
Me.Requery

DoCmd.OpenForm ("ANNO1")

End Sub

[LMondi]

Ciao defra !
In un programma realizzato tempo fa ho una routine che verifica nel BD se è inserito il nome di un professionista, se è inserito restituisce un messaggio altrimenti salva il Nome, cognome, ... nome del file. La routine la posto di seguito, fai tu le modifiche eventualmente necessarie per adattarla alla tua realtà:

'Salva nel DB i Dati anagrafici del Professionista  TblAnagraficaPROF - FrmProf:
Public Sub SalvaDBAnagPr()
    
    Dim Ogg1 As New ADODB.Command
    Dim Cns1 As New ADODB.Connection
    Dim RSTctr As New ADODB.Recordset
           
     ' Il file deve essere salvato nel DB:
        btConf = 0
    
    'Esegue la connessione con il DataBase TblAnagraficaPROF:
        With Cns1
            .ConnectionString = DataConnessione
            .CursorLocation = adUseClient   'tipo di cursore
            .Mode = adModeShareDenyNone     'nessuna limitazione
            .CommandTimeout = 15
            .Open
        End With
    
    ' Controlla che il professionista ed il progetto NON sia inserito già nel BD:
        RSTctr.Source = "SELECT Nome, Cognome, NomeFile FROM TblAnagraficaPROF WHERE Nome='" & FrmAnagProf.TxtPr1.Text & "' And Cognome='" & FrmAnagProf.TxtPr2.Text & "' And  NomeFile= '" & NomeNF & "'"
        RSTctr.Open , Cns1
        
        ' Il Professionista è presente nel DB, esce dalla routine:
        If RSTctr.EOF = False And RSTctr.BOF = False Then
            MsgBox "Il professionista: " & FrmAnagProf.TxtPr1.Text & " " & FrmAnagProf.TxtPr2.Text & " che ha redatto il computo metrico " & NomeNF & Chr(13) _
            & "è già registrato nel database.", vbInformation + vbOKOnly, "AA - Determinazione ....."
        ' Conferma il salvataggio nel DB:
            btConf = 1
        ' Indica che il file è stato salvato:
            boolVerifica2 = True
        End If
         
    
        If RSTctr.EOF = True And RSTctr.BOF = True Then
            ' Il Professionista che ha redatto il progetto Non è presente nel DB, viene inserito:
            Ogg1.ActiveConnection = Cns1
            Ogg1.CommandType = adCmdText
        
            Ogg1.CommandText = "insert into TblAnagraficaPROF(Titolo, Nome, Cognome, PartitaIVA, Ordine, Matricola, TipoVia, Via, NCivico, Cap, Citta, Provincia, Telefono, Cellulare, Fax, Email, NomeFile)" _
                & "values ('" & Replace(FrmAnagProf.CmbPr1.Text, "'", "''") & "', '" & Replace(FrmAnagProf.TxtPr1.Text, "'", "''") & "', '" & Replace(FrmAnagProf.TxtPr2.Text, "'", "''") _
                & "', '" & Replace(FrmAnagProf.TxtPr3.Text, "'", "''") & "', '" & Replace(FrmAnagProf.CmbPr4.Text, "'", "''") & "' ,'" & Replace(FrmAnagProf.TxtPr12.Text, "'", "''") _
                & "', '" & Replace(FrmAnagProf.CmbPr2.Text, "'", "''") & "', '" & Replace(FrmAnagProf.TxtPr4.Text, "'", "''") & "' ,'" & Replace(FrmAnagProf.TxtPr5.Text, "'", "''") _
                & "', '" & Replace(FrmAnagProf.TxtPr6.Text, "'", "''") & "', '" & Replace(FrmAnagProf.TxtPr7.Text, "'", "''") & "' ,'" & Replace(FrmAnagProf.CmbPr3.Text, "'", "''") _
                & "', '" & Replace(FrmAnagProf.TxtPr8.Text, "'", "''") & "', '" & Replace(FrmAnagProf.TxtPr9.Text, "'", "''") & "', '" & Replace(FrmAnagProf.TxtPr10.Text, "'", "''") _
                & "', '" & Replace(FrmAnagProf.TxtPr11.Text, "'", "''") & "', '" & Replace(FrmAnagProf.TxtNomeF.Text, "'", "''") & "');"
            Ogg1.Execute
            
            ' Conferma il salvataggio nel DB:
            btConf = 1
            ' Indica che il file è stato salvato:
            boolVerifica2 = True
        End If

' Chiude la connessione:
        Cns1.Close
        Set Cns1 = Nothing
'Chiude e cancella il recordSet:
        Set RSTctr = Nothing
        RSTctr.Close

End Sub

[mgmg]

Se hai già modificato la tua procedura da dao ad ado questo non serve, altrimenti dopo la seek devi controllare se hai trovato il record in questo modo:
RS.Index = "ID_PAZIENTI"
RS.Seek "=", Me!ID_PAZIENTI
If not(RS.NoMatch) then

MsgBox "Attenzione codice già esistente"

Else
RS.AddNew
RS!ID_PAZIENTI = Me!ID_PAZIENTI
RS.Update

End If

RS.Close
perchè se il record non esiste non può fare il controllo:
RS!ID_PAZIENTI = Me!ID_PAZIENTI

Ciao

[defra]

Ho provato sia con dao che con ado ma mi da il seguente problema:
Impossibile aggiungere o modificare il record. Nella tabella "pazienti" è necessario un record correlato.
Posto il codice (la macro1 fa aprire la mschera al record corrispondente):


' apre la tabella
Set RS = CurrentDb.OpenRecordset("FARMACI")

' Cerca il record

RS.Index = "ID_PAZIENTE"
RS.Seek "=", Me!ID_PAZIENTE

If Not (RS.NoMatch) Then
MsgBox "Terapia già inserita"
DoCmd.RunMacro "Macro1"
Exit Sub
Else

RS.AddNew
RS!ID_PAZIENTE = Me!ID_PAZIENTE
RS.Update
DoCmd.RunMacro "Macro1"
End If

RS.Close

[Andriy88]

sicuramente non hai costruito bene il tuo db