none
Access - Transações VBA RRS feed

  • Pergunta

  • Criei uma rotina para criar uma escala diária de trabalho. São duas tabelas:  EmpregadoEscalaDeTrabalho e EmpregadoEscalaDeTrabalho_Itens.

    A rotina se rodada dentro da transação, gera um erro ao incluir o segundo empregado na escala, ver comentário no código. 

    Rodando a rotina fora de uma transação, a falha não ocorre, Porque?

    O código da rotina esta em uma transação.

    Public Function FP_criarEscalaDeTrabalho(idCond As Long, intMes As Integer, intAno As Integer) As Boolean
    On Error GoTo Erro
    Dim cn As New ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strEMP() As String
    Dim strListaEMP As String
    Dim idEmp As Long
    Dim strSQL As String
    Dim UltimaData As Date
    Dim novaData As Date
    Dim ultimoDiaMes As Integer
    Dim limite As Date
    Dim idEscala As Long
    Dim i As Integer
    Dim empEscala As Boolean
        
        Set cn = CurrentProject.Connection
    
        'Verificar ultimo dia do mês
        ultimoDiaMes = FP_ultimoDiaMes(intMes, intAno)
        limite = ultimoDiaMes & "/" & Format$(intMes, "00") & "/" & intAno
    
        'Apura a data da última escala criada.
        UltimaData = DMax("[data]", "EmpregadoEscalaDeTrabalho")
    
        If limite <= UltimaData Then
            MsgBox "Escala mês " & Format$(intMes, "00") & "/" & intAno & " já criada.", vbInformation, "Escala de trabalho"
            FP_criarEscalaDeTrabalho = False
            Exit Function
        End If
    
        cn.BeginTrans
    
        novaData = DateAdd("d", 1, UltimaData)
        
        While novaData <= limite
            'Adiciona uma nova escala de trabalho
            strSQL = "SELECT id_EmpregadoEscalaDeTrabalho, idCondominio, data" _
            & " FROM EmpregadoEscalaDeTrabalho"
            Set rs = New ADODB.Recordset
            rs.CursorLocation = adUseClient
            rs.Open strSQL, cn, adOpenKeyset, adLockOptimistic
            
            rs.AddNew
            rs.Fields("idCondominio") = idCond
            rs.Fields("data") = novaData
            rs.Update
            idEscala = rs.Fields("id_EmpregadoEscalaDeTrabalho")
            
            rs.Close
            '--------------------------------------------------------------------------------------------------------
            
            'Apura empregados a serem incluídos na nova escala
            strListaEMP = FPV_apuraEmpregadoEscala(novaData, idCond)
            strEMP = Split(strListaEMP, ";")
            
            'Insere empregados na escala
            For i = 0 To UBound(strEMP, 1)
                strSQL = "INSERT INTO EmpregadoEscalaDeTrabalho_Itens" _
                & " (id_EmpregadoEscalaDeTrabalho, idEmpregado)" _
                & " VALUES (" & idEscala & "," & strEMP(i) & ")"
                '----------------------------------------------------------------------------------------------------
                DoCmd.RunSQL strSQL 'ERRO:IMPOSSÍVEL LER REGISTRO. ELE FOI BLOQUEADO POR OUTRO USUÁRIO
                '----------------------------------------------------------------------------------------------------
            Next i
            
            novaData = DateAdd("d", 1, novaData)
            
        Wend
        
        .CommitTrans
        FP_criarEscalaDeTrabalho = True
        
        MsgBox "Fim"
    Sair:
        Set cn = Nothing
        Set rs = Nothing
        Exit Function
        
    Erro:
        MsgBox Err.Number & vbCrLf & Err.Description, vbInformation, "Erro - Criar Escala Trabalho"
        cn.RollbackTrans
        FP_criarEscalaDeTrabalho = False
        Resume Sair
    End Function
    



    [b]Sergio Ivanenko[/b]

    segunda-feira, 30 de junho de 2014 15:28