[RESOLVIDO] Atualizar uma tabela inteira (Linha por Linha) Automaticamente

Boa tarde.
Possuo uma tabela em Excel que estou "portando" para o Access. Essa planilha é cheia de fórmulas do tipo PROCV, que buscam informações em outras planilhas para manter os dados sempre atualizados.  O fato é que, como o Access não aceita fórmulas nas tabelas, pensei em resolver esse problema da atualização dessa tabela com um botão "Atualizar dados".
Criei um botão que passa registro por registro e busca os dados das tabelas correspondentes e vai atualizando a tabela tabRota.
O problema é que, quando eu clico, simplesmente aparece a mensagem final (atualizado com sucesso) porém nada é realizado. Essa tabela é bem grande e meu pc é lento, porém o botão retorna essa msg com menos de 1 segundo, o que significa que ele não passou nem sequer por um registro do loop.
Não estou sabendo encontrar o erro, poderiam me ajudar?
Desde já obrigado!

Segue o código:

Código:

Private Sub cmdAtualizarDadosRota_Click()
    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 Recordset, SqlMapaAtual As String 'Mapa
    Dim rsFleet As Recordset, SqlFleetAtual As String 'Contador Fleet
    Dim rsPapel As Recordset, SqlPapelAtual As String  'Papel
    
    strSQL = "tabRota"
    Set rsRota = CurrentDb.OpenRecordset(strSQL)
    
    With rsRota
        If Not .BOF And Not .EOF Then
            .MoveLast
            .MoveFirst
            While (Not .EOF)
                
                SerieAtual = ![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)
                If .Updatable Then

                    .Edit
                    
                    If Not rsMapa.RecordCount = 0 Then
                        'Dados do Mapa'
                        ![Status] = IIf(IsNull(rsMapa!Status), "", rsMapa!Status)
                        ![Modelo] = IIf(IsNull(rsMapa!ModeloSimpress), "", rsMapa!ModeloSimpress)
                        ![Fila] = IIf(IsNull(rsMapa!Fila), "", rsMapa!Fila)
                        ![Empresa] = IIf(IsNull(rsMapa!Empresa), "", rsMapa!Empresa)
                        ![PlantaInstalada] = IIf(IsNull(rsMapa!PlantaInstalada), "", rsMapa!PlantaInstalada)
                        ![LocalInstalacao] = IIf(IsNull(rsMapa!LocalInstalacao), "", rsMapa!LocalInstalacao)
                        ![Ramal] = IIf(IsNull(rsMapa!Ramal), "", rsMapa!Ramal)
                        ![Horario] = IIf(IsNull(rsMapa!Horario), "", rsMapa!Horario)
                        ![Rua] = IIf(IsNull(rsMapa!RuaRef), "", rsMapa!RuaRef)
                        ![DeptoAlmox] = IIf(IsNull(rsMapa!DEPARTAMENTO), "", rsMapa!DEPARTAMENTO)
                        ![Contrato] = IIf(IsNull(rsMapa!Contrato), "", rsMapa!Contrato)
                        'Dados do Contador'
                        ![VidaUtilToner] = IIf(IsNull(rsFleet!TonerPretoPorcentagem), "", rsFleet!TonerPretoPorcentagem)
                        ![ContFinal] = IIf(IsNull(rsFleet!NumerodePaginas), "", rsFleet!NumerodePaginas)
                        'Dados do Papel'
                        ![Media] = IIf(IsNull(rsPapel!Media), "", rsPapel!Media)
                        ![A4] = IIf(IsNull(rsPapel!A4Resma), "", rsPapel!A4Resma)
                        ![A3] = IIf(IsNull(rsPapel!A3Media), "", rsPapel!A3Media)
                        'Fórmulas'
                        ContadorInicialAtual = IIf(IsNull(![ContInicial]), "", ![ContInicial])
                        ContadorFinalAtual = Val(![ContFinal])
                        ![Producao] = ContadorFinalAtual - ContadorInicialAtual
                        ![Estoque] = (Val(![A4]) * 500) - Val(![Producao])
                        If Val(![VidaUtilToner]) <= 5 Then
                            ![MandarToner] = "Mandar Toner"
                        Else
                            ![MandarToner] = "Toner OK"
                        End If
                        MsgBox "1"
                    Else
                        MsgBox "A tabela de Rota está Vazia. Favor Verificar."
                    End If
                    

                        
                    .Update
                    'And finally we will need to confirm the update
                    
                End If
                Set rsMapa = Nothing
                Set rsFleet = Nothing
                Set rsPapel = Nothing
                .MoveNext
                '(Pause com CTRL+Break)
            Wend
        End If
        .Close
    End With
    
ExitSub:
        Set rsRota = Nothing
        MsgBox "A tabela de Rota foi atualizada com sucesso."
        Exit Sub
ErrorHandler:
        Resume ExitSub
End Sub

Segue o link do projeto:
alantaru.000webhostapp.com/BANCO_DE_DADOS/atualizar_tabela.zip

Alan boa tarde,

O problema está no vinculo das planilhas.
Refaça os vínculos que irá funcionar.

Boa sorte

Bom dia.
Como assim? É no código?
Revisei o código e está com os nomes corretos.
COmo faço para revincular as planilhas?

Ele dá a mensagem de sucesso porque a mensagem está no lugar errado.

Repare que você não tem o campo "A3Media" no SQL:

Código:

SqlPapelAtual = "SELECT Serie, TotalFv, A4Resma, Media  " & _
                    "FROM Papel " & _
                    "WHERE Serie='" & SerieAtual & "';"

Mas depois vai invocar esse campo no recordset que não existe "rsPapel!A3Media".

O seu tratamento de erros tem de ser assim:

Código:

ExitSub:
        Set rsRota = Nothing
        MsgBox "A tabela de Rota foi atualizada com sucesso."
        Exit Sub
ErrorHandler:
Dim Msg$
    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
End Sub


Para recriar os vínculos com as planilhas, clique com o botão direito do mouse sobre a tabela, e selecione o menu "Gerenciador de Tabelas Vinculadas".
Em seguida, selecione o local onde se encontra a planilha e clique em "Vincular Novamente"

Conforme o JPaulo mencionou, a mensagem de sucesso de atualização está dentro do tratamento de erro, ou seja, ao gerar o erro, cai no tratamento e este tratamento exibe a mensagem incorreta.

Boa sorte

[]'s

Detetei inumeros erros na codificação;

Aguarde pelo seu código corrigido;

Olá;

Seu código foi todo alterado.

Substitua todo por este, teste e retorne por favor;

Código:

Private Sub cmdAtualizarDadosRota_Click()
    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 = ![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
                        ![VidaUtilToner] = Nz(rsFleet!TonerPretoPorcentagem, "")
                        ![ContFinal] = Nz(rsFleet!NumerodePaginas, "")
                        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
                        ![Media] = Nz(rsPapel!Media, "")
                        ![A4] = Nz(rsPapel!A4Resma, "")
                        '![A3] = IIf(IsNull(rsPapel!A3Media), "", rsPapel!A3Media)
                        End If
                       
                        'Fórmulas'
                        ContadorInicialAtual = Val(Nz(![ContInicial], 0))
                        ContadorFinalAtual = Val(![ContFinal])
                        ![Producao] = Val(Nz(ContadorFinalAtual, 0)) - Val(Nz(ContadorInicialAtual, 0))
                        ![Estoque] = (Val(![A4]) * 500) - Val(![Estoque])
                       
                        If Val(![VidaUtilToner]) <= 5 Then
                            ![MandarToner] = "Mandar Toner"
                        Else
                            ![MandarToner] = "Toner OK"
                        End If
                                         
                    .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
End Sub

Bom dia, desculpe a demora para responder.
Eu colei o código, aparentemente está funcionando, porém está aparecendo esta mensagem:

Spoiler:

Não consigo ver exatamente qual campo está causando o problema, para alterar seu tipo. Tem como colocar essa informação na mensagem de erro?


Segue o link do projeto modificado:
http://alantaru.000webhostapp.com/BANCO_DE_DADOS/ATUALIZAR_AUTOMATICAMENTE.zip

Acredito que encontrei o erro, estava acontecendo em outra tabela.
Tenho um campo chamado TonerPretoPorcentagem, que pode conter tanto valores numéricos quanto texto. Esse campo que está dando problema.
Alterei o código dele para verificar se, caso seja numérico retorne o valor normal, mas caso não seja, retorne "" como descrito abaixo e resolveu o erro.
Muito obrigado a todos pela ajuda!

Código:

                       '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
                            ![ContFinal] = Nz(rsFleet!NumerodePaginas, "")
                            End If

E isso mesmo.

Fico feliz, obrigado pelo retorno o forum agradece.