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]Importar XML - erro de timeout

    Compartilhe

    Alex Brito
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3
    Registrado : 09/07/2016

    [Resolvido]Importar XML - erro de timeout

    Mensagem  Alex Brito em 24/10/2018, 03:43

    Boa noite, fiz alguma pesquisas no Google e consegui achar um código vba para importar xml.
    Contudo, o código cria um objeto utilizando o xmlhttprequest, método GET, mas ao abrir o objeto está dando erro de timeout. Adicionei um parâmetro para alterar o tempo de timeout mas não deu certo.
    A fonte xml é de parlamentares da Câmara, [Você precisa estar registrado e conectado para ver este link.]
    São aproximadamente 5 ou 6 páginas. Quero carregar em uma tabela de forma automática. Clicar em um botão carregar e executar o código.
    Alguém já fez algo parecido.
    Desde já agradeço a atenção.
    avatar
    IvanJr.
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 161
    Registrado : 22/11/2016

    Re: [Resolvido]Importar XML - erro de timeout

    Mensagem  IvanJr. em 24/10/2018, 07:10

    Veja se o arquivo em anexo atende. Para atualizar basta dar dois cliques na macro criada.

    código principal
    Código:
    Private xmlDOC As MSXML2.DOMDocument60

    Private Sub fncPegaXML()
    On Error GoTo trataerro

        Dim xmlHttp As MSXML2.XMLHTTP60
        
        Set xmlHttp = New MSXML2.XMLHTTP60
        With xmlHttp
            .Open "GET", "http://www.camara.leg.br/SitCamaraWS/Deputados.asmx/ObterDeputados", False
            .setRequestHeader "Content-Type", "text/xml; charset=utf-8"
            .setRequestHeader "Content-Length", "Length"
            .send
        End With
        
        If CLng(xmlHttp.Status) < 300 Then
            Set xmlDOC = New MSXML2.DOMDocument60
            xmlDOC.loadXML xmlHttp.responseText
        Else
            Set xmlDOC = Nothing
        End If
        
    sair:
        Set xmlHttp = Nothing
        Exit Sub
        
    trataerro:
        Resume sair:

    End Sub

    Public Function fncPopulaTabela()

        Dim ndNodeDeputado As MSXML2.IXMLDOMNode
        Dim ndNodeInformacoes As MSXML2.IXMLDOMNode
        Dim rs As DAO.Recordset

        Call fncPegaXML
        
        If xmlDOC Is Nothing Then
            MsgBox "Não foi possível atualizar a tabela.", vbCritical, "Aviso"
        Else
        
            CurrentDb.Execute "delete * from tblDeputados;"
            Set rs = CurrentDb.OpenRecordset("tblDeputados", , 8)
        
            For Each ndNodeDeputado In xmlDOC.childNodes(1).childNodes
                rs.AddNew
                    For Each ndNodeInformacoes In ndNodeDeputado.childNodes
                        If Eval("'" & ndNodeInformacoes.nodeName & "' not in('urlFoto','comissoes')") Then
                            rs.Fields(ndNodeInformacoes.nodeName).Value = ndNodeInformacoes.Text
                        End If
                    Next ndNodeInformacoes
                rs.Update
            Next ndNodeDeputado
            
            rs.Close: Set rs = Nothing
            Set xmlDOC = Nothing
            
            MsgBox "Tabela atualizada.", vbInformation, "Aviso"
            
        End If

    End Function
    Anexos
    deputados.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (69 Kb) Baixado 6 vez(es)

    Alex Brito
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3
    Registrado : 09/07/2016

    Resolvido

    Mensagem  Alex Brito em 24/10/2018, 15:18

    IvanJr. muito obrigado!
    Problema resolvido.
    Vou avaliar agora o que eu estava fazendo errado no código que estava utilizando.
    Muito obrigado! cheers
    avatar
    IvanJr.
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 161
    Registrado : 22/11/2016

    Re: [Resolvido]Importar XML - erro de timeout

    Mensagem  IvanJr. em 24/10/2018, 15:36

    Obrigado pelo retorno. O fórum agradece. Faltou só marcar o tópico como resolvido.

    Alex Brito
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3
    Registrado : 09/07/2016

    Re: [Resolvido]Importar XML - erro de timeout

    Mensagem  Alex Brito em 24/10/2018, 15:40

    Resolvido. Obrigado

      Data/hora atual: 16/11/2018, 03:59