[Resolvido]Extrair dados XML

Prezados colegas!

Tenho uma pasta onde salvo arquivos xml. Meu objetivo é criar um formulario que liste o nome desses arquivos e extraia algumas informações também. Cheguei perto do que pretendo, porém usando um único arquivo e exibindo os valores através de msgbox.

O código que estou utilizando obtive através dos posts dos amigos Avelino Sampaio e anteixeira

Código:

Option Compare Database
Dim meuFicheiro As String, textoXml As String, textoLinha As String

Private Sub Form_Load()
Dim strArquivo As String
Dim strCaminho As String
CurrentDb.Execute "DELETE FROM XML;"
strCaminho = "C:\BRADESCO\"
strArquivo = Dir$(strCaminho & "*.xml")
Do While Len(strArquivo) > 0
    CurrentDb.Execute "INSERT INTO XML (XML) VALUES('" & strArquivo & "');"
    strArquivo = Dir$()
    Form.SUBXML.Requery
    Loop
  meuFicheiro = Application.CurrentProject.Path & "\ALPINA-15797.xml"
        
    Open meuFicheiro For Input As #1
        Do Until EOF(1)
            Line Input #1, textoLinha
             textoXml = textoXml & textoLinha
        Loop
    Close #1

'MsgBox textoXml, vbInformation, "Conteodo do Xml"
MsgBox "Campo nNF:   " & separaEntreDuasStringsXML(textoXml, "<nNF>", "</nNF>") 'exibir em coluna
MsgBox "Campo xNome:   " & separaEntreDuasStringsXML(textoXml, "<xNome>", "</xNome>") 'exibir em coluna
MsgBox "Campo data:   " & separaEntreDuasStringsXML(textoXml, "<dhEmi>", "</dhEmi>") 'exibir em coluna

End Sub
'2014 Alvaro Teixeira
Function separaEntreDuasStringsXML(strTotal As String, strInicio As String, strFim As String)
Dim i As Long, j As Long
    i = InStr(strTotal, strInicio)
    j = InStr(strTotal, strFim)
    separaEntreDuasStringsXML = Mid(strTotal, i + Len(strInicio), j - i - Len(strInicio))
End Function


Gostaria de exibir os dados dessa forma:


Desde já, agradeço a ajuda dos colegas!!

Olá Isaque Toledo,

Poste uma base de dados com os objetos envolvidos na questão e dois ficheiros XML (com dados de amostragem) para se testar.

Assim fica mais fácil para ajudar.

Abraço

Prezado anteixeira,segue os arquivos.

Olá Isaque Toledo,

Acho que é o que pretende, veja código utilizado comentado:

Código:

Option Compare Database

Private Sub cmdProcessar_Click()
'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 String, tmp_xNome As String, tmp_dhEmi As String

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

'definir caminho e extensão do tipo de ficheiro a pesquisar
strCaminho = "C:\local\"
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>")
            tmp_xNome = separaEntreDuasStringsXML(textoXml, "<xNome>", "</xNome>")
            tmp_dhEmi = separaEntreDuasStringsXML(textoXml, "<dhEmi>", "</dhEmi>")
        Close #1 'fechar ficheiro
    
    
        'consulta acrescentar
        CurrentDb.Execute "INSERT INTO XML (XML, xNome, nNF, dhEmi) VALUES('" & strArquivo & "', '" & tmp_xNome & "', '" & tmp_nNF & "', '" & tmp_dhEmi & "');"
        strArquivo = Dir$()
        Form.SUBXML.Requery
    Loop

End Sub

'2014 Alvaro Teixeira
Function separaEntreDuasStringsXML(strTotal As String, strInicio As String, strFim As String)
Dim i As Long, j As Long
    i = InStr(strTotal, strInicio)
    j = InStr(strTotal, strFim)
    separaEntreDuasStringsXML = Mid(strTotal, i + Len(strInicio), j - i - Len(strInicio))
End Function


Segue o meu teste:
cld.pt/dl/download/2eecb899-bd7c-498d-93ab-8b1a280cb715/BDXML_rev.zip

Abraço

Prezado anteixeira!

Agradeço imensamente por sua ajuda. Ficou perfeito.

Muitissimo obrigado!!

Abraço.

Olá Isaque Toledo,

Fico feliz por ter ajudado!
Obrigado pelo retorno, o fórum agradece.

Abraço