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]
