MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

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

    Compartilhe
    avatar
    alantaru
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 47
    Registrado : 04/10/2018

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

    Mensagem  alantaru em 10/12/2018, 16:54

    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


    Última edição por alantaru em 12/12/2018, 10:22, editado 1 vez(es)
    avatar
    Alexandre Fim
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 582
    Registrado : 13/12/2016

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

    Mensagem  Alexandre Fim em 10/12/2018, 18:10

    Alan boa tarde,

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

    Boa sorte
    avatar
    alantaru
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 47
    Registrado : 04/10/2018

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

    Mensagem  alantaru em 11/12/2018, 10:00

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

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10357
    Registrado : 04/11/2009

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

    Mensagem  JPaulo em 11/12/2018, 13:37

    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".



    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    Utilize o Sistema de Busca do Fórum...
    102 Códigos VBA Gratuitos...
    Instruções SQL como utilizar...
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10357
    Registrado : 04/11/2009

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

    Mensagem  JPaulo em 11/12/2018, 13:40

    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


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    Utilize o Sistema de Busca do Fórum...
    102 Códigos VBA Gratuitos...
    Instruções SQL como utilizar...
    avatar
    Alexandre Fim
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 582
    Registrado : 13/12/2016

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

    Mensagem  Alexandre Fim em 11/12/2018, 13:45

    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
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10357
    Registrado : 04/11/2009

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

    Mensagem  JPaulo em 11/12/2018, 14:06

    Detetei inumeros erros na codificação;

    Aguarde pelo seu código corrigido;



    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    Utilize o Sistema de Busca do Fórum...
    102 Códigos VBA Gratuitos...
    Instruções SQL como utilizar...
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10357
    Registrado : 04/11/2009

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

    Mensagem  JPaulo em 11/12/2018, 17:42

    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


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    Utilize o Sistema de Busca do Fórum...
    102 Códigos VBA Gratuitos...
    Instruções SQL como utilizar...
    avatar
    alantaru
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 47
    Registrado : 04/10/2018

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

    Mensagem  alantaru em 12/12/2018, 10:06

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

    Spoiler:
    Erro # -2147352567 gerado no DAO.Field

    Descrição: Não é possível registrar as alterações porque um valor digitado viola as configurações definidas para esta tabela ou lista (por exemplo, um valor é menor que o mínimo ou maior que o máximo). Corrija o erro e tente novamente.

    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
    avatar
    alantaru
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 47
    Registrado : 04/10/2018

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

    Mensagem  alantaru em 12/12/2018, 10:21

    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
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10357
    Registrado : 04/11/2009

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

    Mensagem  JPaulo em 12/12/2018, 10:41

    E isso mesmo.

    Fico feliz, obrigado pelo retorno o forum agradece.


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    Utilize o Sistema de Busca do Fórum...
    102 Códigos VBA Gratuitos...
    Instruções SQL como utilizar...

      Data/hora atual: 18/1/2019, 12:18