Errore transazione 3034

Buongiorno a tutti e Buon Natale,

Nel mio database, sto lavorando sulla maschera frmNuovoProdotto.
Nella maschera vengono inseriti i vari dati relativi al prodotto. Al click del pulsante "Salva", l'idea è quella di far gestire il salvataggio dei relativi dati da una transazione, visto che bisogna agire su varie tabelle (tabProdotti e tabPrezzi).

In sostanza prima verifico che siano stati immessi tutti i dati (attraverso la funzione Verifica) e poi inserisco i nuovi record nelle tabelle.

Ecco il codice:

Private Sub cmdSalva_Click()
DAO.DBEngine.BeginTrans
    On Error GoTo tran_Err
    'Verifica che la maschera sia compilata interamente
    Dim maschera As Form
    Set maschera = Me
    Verifica (maschera.Name)
    
    'Se la categoria prodotto è "Prestazioni"
    If Me.cboIDCategoriaProdotto = 2 Then
        'Se non ci sono già prezzi registrati
        If DCount("IDPrezzo", "qryVerificaEsistenzaProdotto", "Descrizione = " & "'" & Me.Descrizione & "'" & " AND IDListino = 2") = 0 Then
            Dim strSQL1 As String
            Dim strSQL2 As String
            Set dbs = CurrentDb
            
         'Compila le tabelle
            strSQL1 = "INSERT INTO tabProdotti (IDProdotto, IDSottocategoriaProdotto,IDTipoIva, IDProduttore, Descrizione)" & _
                    "VALUES (" & Me.IDProdotto & "," & Me.cboIDSottocategoriaProdotto & "," & Me.IDTipoIva & "," & Me.cboIDProduttore & ", '" & Me.Descrizione & "')"
            dbs.Execute strSQL1, dbFailOnError
            
            strSQL2 = "INSERT INTO tabPrezzi (IDProdotto, IDListino, PrezzoUnitario , DataInizioValidita, DataFineValidita )" & _
                    "VALUES (" & Me.txtIDProdotto & ", 2," & Me.txtPrezzoVenditaEff & "," & Str(CDbl(Me.txtDataInizioValidita)) & ", #31/12/9999#);"
            dbs.Execute strSQL2, dbFailOnError
            
            MsgBox "Prodotto registrato con successo", vbOKOnly, " Nuovo Prodotto"
        Else
            MsgBox ("Esiste già un prezzo per questo prodotto")
        End If
        
         'Per le altre categorie
    Else
        'Se non ci sono già prezzi registrati
        If DCount("IDPrezzo", "qryVerificaEsistenzaProdotto", "Descrizione = '" & Me.Descrizione & "' AND IDListino = 1") = 0 Then
            
            Dim strSQL1 As String
            Dim strSQL2 As String
            Dim strSQL3 As String
            Set dbs = CurrentDb
            
            'Compila la tabelle
            strSQL1 = "INSERT INTO tabProdotti (IDProdotto, IDSottocategoriaProdotto,IDTipoIva, IDProduttore, Descrizione)" & _
                    "VALUES (" & Me.IDProdotto & "," & Me.cboIDSottocategoriaProdotto & "," & Me.IDTipoIva & "," & Me.cboIDProduttore & ", '" & Me.Descrizione & "')"
            dbs.Execute strSQL1, dbFailOnError
            
            strSQL2 = "INSERT INTO tabPrezzi (IDProdotto, IDListino, PrezzoUnitario , DataInizioValidita, DataFineValidita )" & _
                    "VALUES (" & Me.txtIDProdotto & ", 1," & Me.txtPrezzoAcq & "," & Str(CDbl(Me.txtDataInizioValidita)) & ", #31/12/9999#);"
            dbs.Execute strSQL2, dbFailOnError
            
            strSQL3 = "INSERT INTO tabPrezzi (IDProdotto, IDListino, PrezzoUnitario , DataInizioValidita, DataFineValidita )" & _
                    "VALUES (" & Me.txtIDProdotto & ", 2," & Me.txtPrezzoVenditaEff & "," & Str(CDbl(Me.txtDataInizioValidita)) & ", #31/12/9999#);"
            dbs.Execute strSQL3, dbFailOnError
            
            MsgBox "Prodotto registrato con successo", vbOKOnly, "Nuovo Prodotto"
        Else
            MsgBox ("Esiste già un prezzo per questo prodotto")
        End If
    End If

DAO.DBEngine.CommitTrans

tran_Err:
    DAO.DBEngine.Rollback
    DoCmd.RunCommand acCmdUndo
    MsgBox "Transaction failed. Error: " & Err.Description

End Sub

La transazione funziona, nel senso che i record vengono correttamente salvati, ma ottengo poi un errore del tipo Errore transazione 3034 si è tentato di eseguire il commit o il rollback di una transazione senza prima iniziarla.

Dopo di questo non riesco più ad apportare modifiche al database. Visualizzo in effetti un altro errore del tipo "Non si dispone di accesso esclusivo al database in questo momento. Le modifiche apportate potrebbero andare perdute.

In rete non ho trovato molte informazioni a riguardo, vorrei sapere cosa ne pensate.

Grazie mille!

Se non ricordo male, in DAO i metodi relativi alle transazioni dovrebbero esser relativi all'oggetto Workspace.
In pratica:

DAO.DBEngine.Workspaces(0).BeginTrans

[...]

DAO.DBEngine.Workspaces(0).CommitTrans

TheTruster

Ciao e grazie per la risposta.
Mi sono accorto ora di aver dimenticato il comando

Exit Sub

dopo il CommitTrans.
Così la transazione sembra funzionare, ma devo ancora testare a fondo.
Mi piacerebbe sapere più in generale cosa ne pensate dell'approccio che ho scelto. Ci sono strade più consone?
Grazie!

ciao,
di regola le transazioni vanno chiuse il prima possibile
perchè potrebbero bloccare o rallentare l'accesso ai dati.

Nel tuo codice ci sono dei msgbox all'interno della transazione
che personalmente sposteri al di fuori
( anche se per ora il tuo programma lo usa una sola persona)

Grazie per la risposta.
Ho provato a togliere completamente le MsgBox dal codice.
Come prima: la transazione funziona, ma in seguito se provo a modificare qualcosa (ad esempio entrare in visualizzazione struttura di una qualsiasi maschera) ottengo l'errore relativo all'accesso esclusivo al database. Chiudendo e riaprendo il database funziona nuovamente.
Idee?

Originariamente inviato da RaoulDuke

Come prima: la transazione funziona, ma in seguito se provo a modificare qualcosa ... ottengo l'errore relativo all'accesso esclusivo al database. Chiudendo e riaprendo il database funziona nuovamente.

1) Hai provato come diceva TheTruster, con il metodo BeginTrans del Workspace e non di DBEngine? Ed ovviamente la relativa chiusura.
2) Dov'è dichiarata la variabile dbs? Non chiudi l'oggetto e non fai il Set a Nothing della variabile.
3) Stessa cosa per la variabile maschera anche se non capisco la sua necessità. Se la usi come mi sembra di capire solo nella chiamata alla funzione Verifica, puoi andare direttamente con Verifica (Me.Name)
Non sappiamo cosa succeda in quella funzione, forse resta qualcosa aperto lì?
Se una volta sistemate le cose di cui ai punti 1), 2) e 3) resta ancora il problema, pubblica la funzione Verifica.
Occhio: il Set a Nothing va fatto comunque, anche (soprattutto!) in caso d'errore. Crea un'etichetta del tipo Exit_Sub: in cui metti queste operazioni e che richiami anche da dentro la gestione dell'errore.

Grazie mille per gli imput.
Ecco il nuovo codice:

Private Sub cmdSalva_Click()
DAO.DBEngine.Workspaces(0).BeginTrans

    Dim strSQL As String
    Dim strSQL1 As String
    Dim strSQL2 As String
    Dim strSQL3 As String
    Dim dbs As Database
    
    On Error GoTo tran_Err
    'Verifica che la maschera sia compilata interamente
    
    Verifica (Me.Name)
    
    'Se la categoria prodotto è "Prestazioni"
    If Me.cboIDCategoriaProdotto = 2 Then
        'Se non ci sono già prezzi registrati
        If DCount("IDPrezzo", "qryVerificaEsistenzaProdotto", "Descrizione = " & "'" & Me.Descrizione & "'" & " AND IDListino = 2") = 0 Then
            Set dbs = CurrentDb
            strSQL = "INSERT INTO tabPrezzi (IDProdotto, IDListino, PrezzoUnitario , DataInizioValidita, DataFineValidita ) VALUES (" & Me.txtIDProdotto & ", 2," & Me.txtPrezzoVenditaEff & "," & Str(CDbl(Me.txtDataInizioValidita)) & ", #31/12/9999#);"
            dbs.Execute strSQL, dbFailOnError
        Else
            'MsgBox ("Esiste già un prezzo per questo prodotto")
        End If
         'Per le altre categorie
    Else
        'Se non ci sono già prezzi registrati
        If DCount("IDPrezzo", "qryVerificaEsistenzaProdotto", "Descrizione = '" & Me.Descrizione & "' AND IDListino = 1") = 0 Then
            
            Set dbs = CurrentDb
            strSQL1 = "INSERT INTO tabProdotti (IDProdotto, IDSottocategoriaProdotto,IDTipoIva, IDProduttore, Descrizione)" & _
                    "VALUES (" & Me.IDProdotto & "," & Me.cboIDSottocategoriaProdotto & "," & Me.IDTipoIva & "," & Me.cboIDProduttore & ", '" & Me.Descrizione & "')"
            dbs.Execute strSQL1, dbFailOnError
            strSQL2 = "INSERT INTO tabPrezzi (IDProdotto, IDListino, PrezzoUnitario , DataInizioValidita, DataFineValidita ) VALUES (" & Me.txtIDProdotto & ", 1," & Me.txtPrezzoAcq & "," & Str(CDbl(Me.txtDataInizioValidita)) & ", #31/12/9999#);"
            dbs.Execute strSQL2, dbFailOnError
            strSQL3 = "INSERT INTO tabPrezzi (IDProdotto, IDListino, PrezzoUnitario , DataInizioValidita, DataFineValidita ) VALUES (" & Me.txtIDProdotto & ", 2," & Me.txtPrezzoVenditaEff & "," & Str(CDbl(Me.txtDataInizioValidita)) & ", #31/12/9999#);"
            dbs.Execute strSQL3, dbFailOnError
        Else
            'MsgBox ("Esiste già un prezzo per questo prodotto")
        End If
    End If

DAO.DBEngine.Workspaces(0).CommitTrans
'MsgBox "Prodotto registrato con successo", vbOKOnly, " Nuovo Prodotto"
tran_Exit:
    DBEngine.Workspaces(0).Close
    Set dbs = Nothing
    
Exit Sub

tran_Err:
    DAO.DBEngine.Workspaces(0).Rollback
    DoCmd.RunCommand acCmdUndo
    MsgBox "Transaction failed. Error: " & Err.Description
    Resume tran_Exit

End Sub

Come prima: funziona, ma stesso errore di accesso al database.

Ecco invece la funzione Verifica:

Public Sub Verifica(maschera)

    Dim controllo As Control
    Dim CasellaTesto As TextBox
    Dim CasellaCombinata As ComboBox
    Dim MascheraCorrente As Form
    Dim intRisposta As Integer
    
    Set MascheraCorrente = Forms(maschera)
    
    For Each controllo In MascheraCorrente.Controls
    
        Select Case controllo.ControlType
        Case acTextBox
            Set CasellaTesto = controllo
            If IsNull(CasellaTesto.Value) Then
                intRisposta = MsgBox("Il campo " & _
                                        CasellaTesto.Name & _
                                        " è vuoto. Vuoi proseguire lo stesso?", _
                                        vbYesNo)
                If intRipsota = vbYes Then
                    Exit Sub
                Else: CasellaTesto.SetFocus
                End If
            End If
            
                
        Case acComboBox
            Set CasellaCombinata = controllo
            If CasellaCombinata.Value = 0 Then
                intRisposta = MsgBox("Il campo " & _
                                        CasellaCombinata.Name & _
                                        " è vuoto. Vuoi proseguire lo stesso?", _
                                        vbYesNo)
                If intRisposta = vbYes Then
                    Exit Sub
                Else: CasellaCombinata.SetFocus
                End If
                
            End If
        End Select
    Next
    
    Set controllo = Nothing
    Set CasellaTesto = Nothing
    Set CasellaCombinata = Nothing
    
End Sub

Grazie per gli aiuti!

Debug passo passo e verifica quale delle ActionsQuery generano il problema, ipotizzo un Null o valore non coerente da qualche parte non gestito...

Inoltre, sarebbe meglio non generalizzare la gestione degli errori.
Credo che sarebbe più efficace valutare almeno Err.Number, così da discriminare se il rilascio dell'errore sia davvero imputabile alla transazione che fallisce o a qualche altro evento che, comunque, andrebbe sempre a far saltare l'esecuzione su tran_Err.

TheTruster

Grazie ad entrambi.
Con il debugging ho individuato un errore nella funzione Verifica (riga 21, intRipsota al posto di intRisposta).
Corretto l'errore il problema per ora non si è più presentato.