Loop para inserir todos os itens da XML em uma tabela, só campos específicos

Pessoal boa noite,


Peguei esse código aqui mesmo no forum, para fazer uma importação de um arquivo XML para uma tabela no access, só para trazer uns campos expecíficos, consegui adaptar, mais só inseri o primeiro 1 registro da NF e sai, tem com percorrer toda a XML e inserir todos os item que tiverem na xml ? só preciso dessas informações na tabela!

nNF (esse consigo fazer uma constante no loop), cProd, xProd, infAdProd,qCom

segue abaixo o código que estou usando, lembrando que ele só está inserindo o primeiro item da NF e depois sai!

Código:


Private Sub importarXML()

'ahteixeira 2019 Maximoaccess
'http://www.maximoaccess.com/t35093-extrair-dados-xml

Dim meuFicheiro As String, textoXml As String, textoLinha As String
Dim strArquivo As String, strCaminho As String
Dim tmp_nNF As Double, tmp_cProd As String, tmp_xProd As String, tmp_infAdProd As String, tmp_qCom As Double

'apaga dados da tabela XML
CurrentDb.Execute "DELETE FROM tb_xml;"

'definir caminho e extensão do tipo de ficheiro a pesquisar
strCaminho = "C:\Users\Washington\Desktop\xml\"
strArquivo = Dir$(strCaminho & "*.xml")

    'faz enquanto existe arquivo *.XML
    Do While Len(strArquivo) > 0
       
        'junta o caminho ao nome do arquivo
        meuFicheiro = strCaminho & strArquivo
        textoXml = ""
   
        Open meuFicheiro For Input As #1 'abre ficheiro para leitura
            Do Until EOF(1) 'ler ficheiro até ao fim linha a linha
                Line Input #1, textoLinha
                textoXml = textoXml & textoLinha
            Loop
            'atribuir às variaveis temporarias os campos do XML
            tmp_nNF = separaEntreDuasStringsXML(textoXml, "<nNF>", "</nNF>") 'numero da xml
            tmp_cProd = separaEntreDuasStringsXML(textoXml, "<cProd>", "</cProd>") 'campo do produto da xml
            tmp_xProd = separaEntreDuasStringsXML(textoXml, "<xProd>", "</xProd>") 'campo da descrição da xml
            tmp_infAdProd = separaEntreDuasStringsXML(textoXml, "<infAdProd>", "</infAdProd>") 'campo do lote da xml
            tmp_qCom = separaEntreDuasStringsXML(textoXml, "<qCom>", "</qCom>") 'campo de quantidade da xml
           
        Close #1 'fechar ficheiro
   
   
        'consulta acrescentar
        CurrentDb.Execute "INSERT INTO tb_xml (nNF, codigo_prod, descricao_prod, lote,qtd) VALUES(" & tmp_nNF & ", '" & tmp_cProd & "', '" & tmp_xProd & "','" & tmp_infAdProd & "'," & tmp_qCom & ");"
        strArquivo = Dir$()
    Loop

End Sub



Ola Carvalho, boa tarde!

Experimente fazer a alteração na parte do código que vou printar abaixo:

Open meuFicheiro For Input As #1 'abre ficheiro para leitura
Do Until EOF(1) 'ler ficheiro até ao fim linha a linha
Line Input #1, textoLinha
textoXml = textoXml & textoLinha
'Loop - COMENTE ESSA LINHA COM A ASPA SIMPLES PARA ELA NÃO SER EXECUTADA VAMOS FECHAR O LOOP EM OUTRO LUGAR
'atribuir às variaveis temporarias os campos do XML
tmp_nNF = separaEntreDuasStringsXML(textoXml, "", "") 'numero da xml
tmp_cProd = separaEntreDuasStringsXML(textoXml, "", "") 'campo do produto da xml
tmp_xProd = separaEntreDuasStringsXML(textoXml, "", "") 'campo da descrição da xml
tmp_infAdProd = separaEntreDuasStringsXML(textoXml, "", "") 'campo do lote da xml
tmp_qCom = separaEntreDuasStringsXML(textoXml, "", "") 'campo de quantidade da xml

' Close #1 'fechar ficheiro - COMENTE ESSA LINHA PARA ELA NÃO SER EXECUTADA NESSE PONTO VOU MOVER ELA DE LUGAR


'consulta acrescentar
CurrentDb.Execute "INSERT INTO tb_xml (nNF, codigo_prod, descricao_prod, lote,qtd) VALUES(" & tmp_nNF & ", '" & tmp_cProd & "', '" & tmp_xProd & "','" & tmp_infAdProd & "'," & tmp_qCom & ");"
strArquivo = Dir$()
Loop ' movi o término do loop para cá para que tanto a atualização das variáveis quanto o select de insert seja executado dentro do laço.
Close #1 'fechar ficheiro ' movi o fechamento do xml para cá, após a execução do laço while.
Loop



Dessa forma a cada interação do loop as variáveis se alteram e o insert acontece linha a linha. Se der tudo certo basta você eliminar as linhas comentadas que foram somente duas.

At.

Luis Abreu