Bom dia amigos!
Este formulário possui uma rotina de atualização que varre todo a sua db atualizando linha por linha.
Porém ao clicar no botão de atualização estou recebendo a mensagem
O erro ocorre quando chega na linha
Segue código do botão completo:
Poderiam me orientar o que estou fazendo de errado?
Obrigado!!
Este formulário possui uma rotina de atualização que varre todo a sua db atualizando linha por linha.
Porém ao clicar no botão de atualização estou recebendo a mensagem
O erro ocorre quando chega na linha
- Código:
Set rsMapa = CurrentDb.OpenRecordset(SqlMapaAtual)
Segue código do botão completo:
- Código:
Private Sub cmdAtualizarDadosRota_Click()
Dim resultado As VbMsgBoxResult
resultado = MsgBox("Este processo pode demorar alguns minutos. Tem certeza que deseja atualizar o banco de dados da Rota?", vbYesNo, "Atualizar Rota Proativa")
If resultado = vbYes Then
On Error GoTo ErrorHandler
Dim SerieAtual As String
Dim ContadorInicialAtual As String
Dim ContadorFinalAtual As String
Dim rsRota As DAO.Recordset, strSQL As String 'Rota
Dim rsMapa As DAO.Recordset, SqlMapaAtual As String 'Mapa
Dim rsFleet As DAO.Recordset, SqlFleetAtual As String 'Contador Fleet
Dim rsPapel As DAO.Recordset, SqlPapelAtual As String 'Papel
Dim db As DAO.Database
'apulheta de espera no mouse
DoCmd.Hourglass True
strSQL = "tabRota"
Set db = CurrentDb
Set rsRota = db.OpenRecordset(strSQL)
'se não existirem registros na tabela rota, morre aqui
If rsRota.RecordCount = 0 Then DoCmd.Hourglass False: Exit Sub
With rsRota
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
While (Not .EOF)
SerieAtual = Forms![frmRota]![Serie] 'pega a serie atual
SqlMapaAtual = "SELECT Serie, Status, ModeloSimpress, Fila, Empresa, PlantaInstalada, LocalInstalacao, RAMAL, Horario, RuaRef, DEPARTAMENTO, Contrato FROM Mapa WHERE Serie='" & SerieAtual & "';"
SqlFleetAtual = "SELECT Serie, NumerodePaginas, TonerPretoPorcentagem, ImpressoesTotalemPreto, ImpressoesTotalColoridas FROM Contador WHERE Serie='" & SerieAtual & "';"
SqlPapelAtual = "SELECT Serie, TotalFv, A4Resma, Media FROM Papel WHERE Serie='" & SerieAtual & "';"
Set rsMapa = CurrentDb.OpenRecordset(SqlMapaAtual)
Set rsFleet = CurrentDb.OpenRecordset(SqlFleetAtual)
Set rsPapel = CurrentDb.OpenRecordset(SqlPapelAtual)
.Edit
'Dados do Mapa'
If rsMapa.RecordCount = 0 Then
'se não tiver registros, não faz mais nada
Else
![Status] = Nz(rsMapa!Status, "")
![Modelo] = Nz(rsMapa!ModeloSimpress, "")
![Fila] = Nz(rsMapa!Fila, "")
![Empresa] = Nz(rsMapa!Empresa, "")
![PlantaInstalada] = Nz(rsMapa!PlantaInstalada, "")
![LocalInstalacao] = Nz(rsMapa!LocalInstalacao, "")
![Ramal] = Nz(rsMapa!Ramal, "")
![Horario] = Nz(rsMapa!Horario, "")
![Rua] = Nz(rsMapa!RuaRef, "")
![DeptoAlmox] = Nz(rsMapa!DEPARTAMENTO, "")
![Contrato] = Nz(rsMapa!Contrato, "")
End If
'Dados do Contador'
If rsFleet.RecordCount = 0 Then
![VidaUtilToner] = 0
![ContFinal] = 0
'se não tiver registros, não faz mais nada
Else
If IsNumeric(rsFleet!TonerPretoPorcentagem) Then
![VidaUtilToner] = Nz(rsFleet!TonerPretoPorcentagem, "")
Else
![VidaUtilToner] = "<Sem Suporte>"
End If
If IsNumeric(rsFleet!NumerodePaginas) Then
![ContFinal] = Nz(rsFleet!NumerodePaginas, "")
Else
![ContFinal] = "0"
End If
End If
'Dados do Papel'
If rsPapel.RecordCount = 0 Then
![Media] = 0
![A4] = 0
'se não tiver registros, não faz mais nada
Else
If IsNumeric(rsPapel!Media) Then
![Media] = Nz(rsPapel!Media, "")
Else
![Media] = "0"
End If
If IsNumeric(rsPapel!A4Resma) Then
![A4] = Nz(rsPapel!A4Resma, "")
Else
![A4] = "0"
End If
'![A3] = IIf(IsNull(rsPapel!A3Media), "", rsPapel!A3Media)
End If
'Fórmulas'
ContadorInicialAtual = Val(Nz(![ContInicial], 0))
ContadorFinalAtual = Val(Nz(![ContFinal], 0))
![Producao] = Val(Nz(ContadorFinalAtual, 0)) - Val(Nz(ContadorInicialAtual, 0))
![Estoque] = (Val(Nz(![A4], 0)) * 500) - Val(Nz(![Estoque], 0))
If Val(![VidaUtilToner]) <= 5 Then
![MandarToner] = "Mandar Toner"
Else
![MandarToner] = "Toner OK"
End If
![Competencia] = configCompetencia
.Update
'atualiza o form, á medida que vai alterando
Me.Repaint
.MoveNext
Wend
End If
.Close
End With
ExitSub:
DoCmd.Hourglass False
If Not rsRota Is Nothing Then
Set rsRota = Nothing
End If
MsgBox "A tabela de Rota foi atualizada com sucesso."
Exit Sub
ErrorHandler:
Dim Msg$
DoCmd.Hourglass False
If err.Number <> 0 Then
Msg = "Erro # " & Str(err.Number) & " gerado na " & err.Source _
& vbNewLine & vbNewLine & "Descrição: " & err.Description _
& vbNewLine & vbNewLine & "Por favor contate o Administrador do Sistema."
MsgBox Msg, vbMsgBoxHelpButton + vbCritical, "Erro", err.HelpFile, err.HelpContext
Else
Resume ExitSub
End If
Else
MsgBox "Atualização Cancelada."
End If
End Sub
Poderiam me orientar o que estou fazendo de errado?
Obrigado!!
Última edição por alantaru em 29/11/2022, 15:32, editado 1 vez(es)