[Resolvido]Importar ficheiro Xml com Campos em Linha

Boas, alguém me pode ajudar a concluir a função registaLinhas.
Esse código uso para importar ficheiros .txt e queria adaptar para que fizesse a mesma coisa para ficheiros XML.
Em anexo vem o ficheiro que quero importar, se tiver uma outra forma de importar agradecia a quem pudesse ajudar.

Código:

Function LeFicheiros()
   Dim objFSO, objPasta, objFicheiros, objFicheiro, objTextFile, objFSOXML As Object 'declaracao de variaveis
   Dim strLinha As String
   Set objFSO = CreateObject("Scripting.FileSystemObject") ' variavel de sistema tipo obj file system object
   Set objPasta = objFSO.getFolder("C:\Users\David Morgado\Desktop\Teste\Ficheiros") ' objpasta com a pasta dos ficheiros
   Set objFicheiros = objPasta.Files ' guardar na variavel os ficheiros da pasta
   
   For Each objFicheiro In objFicheiros  ' percorre no ciclo dos ficheiros com o obj ficheiro
       Set objFSOXML = CreateObject("Scripting.FileSystemObject")  ' file system object
       Set objTextFile = objFSOXML.OpenTextFile("C:\Users\David Morgado\Desktop\Teste\Ficheiros\" & objFicheiro.Name, 1) ' abertura do ficheiro nas posicao pretendida, com o 1 no final por defeito
       
       Do While objTextFile.atendofstream = False ' faz enquanto nao chega at end of file
           strLinha = objTextFile.ReadLine  'le linha a linha e guarda na variavel
           RegistaLinhas strLinha, objFicheiro.Name ' está a "apanhar" o nome do ficheiro com o . name
           ' funcao dos record sets, para guardar na base de dados, entra com a variavel que le linha a linha de cada vez
       Loop
       Set objTextFile = Nothing ' garantir que a variavel objtextfile está vazia
       objFSO.MoveFile "C:\Users\David Morgado\Desktop\Teste\Ficheiros\" & objFicheiro.Name, "C:\Users\David Morgado\Desktop\Teste\Tratados\" ' mover os ficheiros integrados para a pasta tratados
       
   Next
   

   
   
End Function

Function RegistaLinhas(strLinha As String, strFicheiro As String) ' nesta funcao entra o strLinha com uma string para os nomes dos ficheiros a guardar em base de dados posteriormente, não podia passar o objFicheiro.Nme


   Dim rstDados As Recordset ' rstDados com o nome da tabela que se prentende guardar os registos
   
   Set rstDados = CurrentDb().OpenRecordset("Dados", dbOpenDynaset) ' variavel definida com a base de dados atual, e entra com o nome da tabela
     

strdelimitado = Split(strLinha, ";")
   If strdelimitado(0) = "INICIO" Or strdelimitado(0) = "FIM" Or strdelimitado(0) = "20" Then ' validar para camioes com texto de inicio ou fim para ignorar e sair da funcao
       Exit Function
   End If
   
   
   
   rstDados.AddNew ' cria uma nova linha em branco na tabela
   
   rstDados![Nome_Camião] = Left(strFicheiro, InStr(strFicheiro, "_") - 0)
   rstDados![Dairy] = strdelimitado(0)
   rstDados![Ves] = strdelimitado(1)
   rstDados![ID] = strdelimitado(2)
   rstDados![Lat] = strdelimitado(3)
   rstDados![Long] = strdelimitado(4)
   rstDados![Nome] = strdelimitado(5)
   rstDados![Q] = strdelimitado(6)
   rstDados![S] = strdelimitado(7)
   rstDados![V] = strdelimitado(8)
   rstDados![V2] = strdelimitado(9)
   rstDados![Avg] = strdelimitado(10)
   
 

   rstDados.Update ' este update é que grava/escreve na tabela da base de dados
   
   Set rstDados = Nothing

End function

Bom dia, alguém me pode ajudar a completar a função registalinhas(), esse código serve para importar xml para uma tabela que tenho de criar com os nome dos campos definidos e estou com dificuldade pois dessa forma que está o código os dados xml ao importar ficam todos na mesma coluna.
Em anexo mando o fichiero xml.
Obrigada

Código:

Function LeFicheiros()
   Dim objFSO, objPasta, objFicheiros, objFicheiro, objTextFile, objFSOxml As Object 'declaracao de variaveis
   Dim strLinha As String
   Set objFSO = CreateObject("Scripting.FileSystemObject") ' variavel de sistema tipo obj file system object
   Set objPasta = objFSO.getFolder("C:\Users\David Morgado\Desktop\Teste\Ficheiros") ' objpasta com a pasta dos ficheiros
   Set objFicheiros = objPasta.Files ' guardar na variavel os ficheiros da pasta
   
   For Each objFicheiro In objFicheiros  ' percorre no ciclo dos ficheiros com o obj ficheiro
       Set objFSOxml = CreateObject("Scripting.FileSystemObject")  ' file system object
       Set objTextFile = objFSOxml.OpenTextFile("C:\Users\David Morgado\Desktop\Teste\Ficheiros\" & objFicheiro.Name, 1) ' abertura do ficheiro nas posicao pretendida, com o 1 no final por defeito
       
       Do While objTextFile.atendofstream = False ' faz enquanto nao chega at end of file
           strLinha = objTextFile.ReadLine  'le linha a linha e guarda na variavel
           RegistaLinhas strLinha, objFicheiro.Name ' está a "apanhar" o nome do ficheiro com o . name
           ' funcao dos record sets, para guardar na base de dados, entra com a variavel que le linha a linha de cada vez
       Loop
       Set objTextFile = Nothing ' garantir que a variavel objtextfile está vazia
       objFSO.MoveFile "C:\Users\David Morgado\Desktop\Teste\Ficheiros\" & objFicheiro.Name, "C:\Users\David Morgado\Desktop\Teste\Tratados\" ' mover os ficheiros integrados para a pasta tratados
       
   Next
 
End Function

'--------------------------------------------------------//-------------------------------------------------------------------------------------------
Function RegistaLinhas(strLinha As String, strFicheiro As String) ' nesta funcao entra o strLinha com uma string para os nomes dos ficheiros a guardar em base de dados posteriormente, não podia passar o objFicheiro.Nme

   Dim rstDados As Recordset ' rstDados com o nome da tabela que se prentende guardar os registos
   
   Set rstDados = CurrentDb().OpenRecordset("Dados", dbOpenDynaset) ' variavel definida com a base de dados atual, e entra com o nome da tabela
   
   strDelimitado = Split(strLinha, ";")
   If strDelimitado(0) = "INICIO" Or strDelimitado(0) = "FIM" Or strDelimitado(0) = "20" Then ' validar para camioes com texto de inicio ou fim para ignorar e sair da funcao
       Exit Function
   End If
   
   rstDados.AddNew ' cria uma nova linha em branco na tabela
   
     
    rstDados![ID] = strDelimitado(0)
    rstDados![S] = strDelimitado(1)
    rstDados![Q] = strDelimitado(2)
    rstDados![V] = strDelimitado(3)
   rstDados![V2] = strDelimitado(4)
   rstDados![Long] = strDelimitado(5)
   rstDados![Lat] = strDelimitado(6)
   rstDados![Nome] = strDelimitado(7)
   rstDados![Avg] = strDelimitado(8)
   rstDados![Dairy] = strDelimitado(9)
   rstDados![SMS] = strDelimitado(10)
   rstDados![Info1] = strDelimitado(11)
   rstDados![Info2] = strDelimitado(12)
   rstDados![Ves] = strDelimitado(13)
   rstDados![City] = strDelimitado(14)
   rstDados![Street] = strDelimitado(15)
   rstDados![Province] = strDelimitado(16)
 

   rstDados.Update ' este update é que grava/escreve na tabela da base de dados
   
   Set rstDados = Nothing

End Function

Olá Carlos,
Sabemos que é um membro novo, bem vindo ao fórum.

Tenha atenção às REGRAS DO FÓRUM

1. Tenha paciência com quem coloca aqui as suas duvidas.
2. Clareza nos títulos dos tópicos e duvidas, evite a linguagem MSN.
3. Não colocar diversas vezes a mesma dúvida.
4. Explicar detalhadamente o problema e informar a versão do seu Office + Sistema Operativo.
5. Retorne sempre se deu certo, esse retorno é muito importante.
6. Respeite toda a equipe Staff e demais membros deste fórum.
7. Use sempre o botão Busca, sempre que tiver uma dúvida e antes de abrir tópicos.
8. Não usar palavras como "Urgente". O fórum é livre e ninguém é obrigado a responder com urgência.
9. A publicidade é proíbida e só pode ser feita pelo Administrador ou depois de aprovada pelo Administrador.
10. Se o seu tópico não for respondido, tem o direito de fazer um Up ao final de 24horas!
11. A colocação de Códigos ou Exemplos, devem constar sempre os créditos de quem o elaborou.
12. Fale, não GRITE! Só letras Maiúsculas, na Internet é o mesmo que gritar!
13. É proibido tirar duvidas nas Salas de Repositório, devem abrir um novo tópico nas salas de duvidas, relacionando o Exemplo em causa.
14. É proibido adicionar links externos nos tópicos, que redirecionem para outros sites ("backlinks"), excepto DropBox ou do próprio fórum.
15. É permitido adicionar links externos, nos códigos VBA dentro das Base de Dados.

Os tópico foi fundido.

Quanto à dúvida, talvez seja melhor montar um pequeno exemplo e partilhar para se testar.

Abraço

Peço desculpa por ter repetido a dúvida.
Como disse para simplificar a minha dúvida era para importar através do vba o ficheiro xml

Olá Carlos,

Como referi, talvez seja melhor disponibilizar um ficheiro XML com dados de amostra e base de dados com o código que tem para se analisar e poder testar.

Assim fica mais fácil para qualquer membro poder ajudar.

Abraço

O ficheiro em anexo serve?

Olá Carlos,

Faltou o anexo, veja como fazer:
https://www.maximoaccess.com/t28813-como-adicionar-arquivo-ficheiro-a-mensagem-no-forum

Abraço

Agora ficou o ficheiro correto?
obrigado

Lamento, mas não sei dizer a aplicação que gere o ficheiro, consigo importar o ficheiro com esse código mas os dados ficam todos num só coluna da tabela do Access e queria ajuda para que os dados ao importar sejam divididos para várias colunas. Mando a foto de como fica a importação do ficheiro com o código vba.

Olá Carlos,

São vários ficheiros a importar ou um de casa vez (por dia, etc)?

Faltou a base de dados com os objetos envolvidos na dúvida para se testar.

Abraço

Pretendo importar vários ficheiros xml para uma única tabela.

Olá Carlos,

Agora estou sem tempo e vou sair.
Mas a forma para solucionar (separar) como pretende, será usar a função separaEntreDuasStringsXML para extrair campo a campo.

Veja neste tópico por exemplo:
https://www.maximoaccess.com/t35093-resolvidoextrair-dados-xml

Se não conseguir amanha, verifico.

Abraço

Não consegui perceber muito bem a função separaEntreDuasStringsXML.
Aguarod então até amanha para ver se mo pode ajudar.
Obrigada

Olá Carlos,

Como tem os campos na mesma linha o exemplo referido não dá.
Foi ncessário usar outra técnica (função) para obter os dados, veja como ficou o código:

Código:

Function LeFicheiros()
    Dim objFSO, objPasta, objFicheiros, objFicheiro, objTextFile, objFSOCSV As Object 'declaracao de variaveis
    Dim strLinha, strCaminho As String
    Dim nrFicheiros As Double
    Dim strID, strS, strQ, strV, strV2, strLong, strLat, strName, strAvg, strDairy, strSMS As String
    Dim strInfo1, strInfo2, strVes, strCity, strStreet, strProvince As String
    
    'strCaminho = "C:\Users\David Morgado\Desktop\Teste"            'caminho original
    strCaminho = Application.CurrentProject.Path                    'caminho para teste, pasta execucao
    nrFicheiros = 0                                                 'limpar contador ficheiros
    
    
    Set objFSO = CreateObject("Scripting.FileSystemObject") ' variavel de sistema tipo obj file system object
    Set objPasta = objFSO.getFolder(strCaminho & "\Ficheiros") ' objpasta com a pasta dos ficheiros
    Set objFicheiros = objPasta.Files ' guardar na variavel os ficheiros da pasta
    
    For Each objFicheiro In objFicheiros  ' percorre no ciclo dos ficheiros com o obj ficheiro
        Set objFSOCSV = CreateObject("Scripting.FileSystemObject")  ' file system object
        Set objTextFile = objFSOCSV.OpenTextFile(strCaminho & "\Ficheiros\" & objFicheiro.Name, 1) ' abertura do ficheiro nas posicao pretendida, com o 1 no final por defeito
        
        nrFicheiros = nrFicheiros + 1   'adicionar ao contador de ficheiros
        
        Do While objTextFile.atendofstream = False   ' faz enquanto nao chega at end of file
            strLinha = objTextFile.ReadLine          'le linha a linha e guarda na variavel
            
            If Left(strLinha, 9) = "<data ID=" Then         'verifica se é uma linha com registos
                strLinha = Replace(strLinha, "<data ", "")     'retira <data  do inicio
                strLinha = Replace(strLinha, "/>", "")         'retira />   do fim
                strLinha = Replace(strLinha, Chr(34), "|")     'substituir aspa dupla por barra vertical
                

                'Separar Campo da linha e atribuir a variavel
                strID = fncSeparaCampoLinha(strLinha, "ID=")
                strS = fncSeparaCampoLinha(strLinha, "S=")
                strQ = fncSeparaCampoLinha(strLinha, "Q=")
                strV = fncSeparaCampoLinha(strLinha, "V=")
                strV2 = fncSeparaCampoLinha(strLinha, "V2=")
                strLong = fncSeparaCampoLinha(strLinha, "Long=")
                strLat = fncSeparaCampoLinha(strLinha, "Lat=")
                strName = fncSeparaCampoLinha(strLinha, "Name=")
                strAvg = fncSeparaCampoLinha(strLinha, "Avg=")
                strDairy = fncSeparaCampoLinha(strLinha, "Dairy=")
                strSMS = fncSeparaCampoLinha(strLinha, "SMS=")
                strInfo1 = fncSeparaCampoLinha(strLinha, "Info1=")
                strInfo2 = fncSeparaCampoLinha(strLinha, "Info2=")
                strVes = fncSeparaCampoLinha(strLinha, "Ves=")
                strCity = fncSeparaCampoLinha(strLinha, "City=")
                strStreet = fncSeparaCampoLinha(strLinha, "Street=")
                strProvince = fncSeparaCampoLinha(strLinha, "Province=")
                
                'consulta acrescentar
                CurrentDb.Execute "INSERT INTO Dados (dID, dS, dQ, dV, dV2, dLong, dLat, dName, dAvg, " _
                                  & "dDairy, dSMS, dInfo1, dInfo2, dVes, dCity, dStreet, dProvince) VALUES('" _
                                  & strID & "', '" & strS & "', '" & strQ & "', '" & strV & "', '" _
                                  & strV2 & "', '" & strLong & "', '" & strLat & "', '" & strName & "', '" _
                                  & strAvg & "', '" & strDairy & "', '" & strSMS & "', '" & strInfo1 & "', '" _
                                  & strInfo2 & "', '" & strVes & "', '" & strCity & "', '" _
                                  & strStreet & "', '" & strProvince & "');"

            End If


        Loop
        Set objTextFile = Nothing ' garantir que a variavel objtextfile está vazia
        objFSO.MoveFile strCaminho & "\Ficheiros\" & objFicheiro.Name, strCaminho & "\Tratados\" ' mover os ficheiros integrados para a pasta tratados
    Next
    
    MsgBox "Foram processados " & nrFicheiros & " ficheiro(s).", vbInformation, "Operação concluída"
    
End Function


Código:

Function fncSeparaCampoLinha(strTotal, strCampo As String)

' Autor ..: Alvaro Teixeira (ahteixeira)
' Para ...: MaximoAccess.com
' Data ...: 19-11-2020
' Função .: fncSeparaCampoLinha
' Obs ....: Separar registo de uma linha com varios registos

Dim i As Long, f As Long

    i = InStr(strTotal, strCampo)
        If i = 0 Then
            Exit Function
        Else
            i = i + Len(strCampo) + 1
        End If
    f = InStr(i, strTotal, "|")
    fncSeparaCampoLinha = Mid(strTotal, i, f - i)

End Function

Foi necessário fazer um ajuste à chave primária da tabela e nome dos campos.
Tenha atenção em não usar Palavras Reservadas do Access.

Abraço

Muito Obrigada, pela ajuda fico eternamente grato, obrigada

Olá Carlos,

Fico feliz po ter ajudado, estude como foi efetuado.
Obrigado pelo feedback, o fórum agradece.

Não se esqueça de dar o tópico como Resolvido, veja como fazer:
https://www.maximoaccess.com/t860-resolucao-de-topicos

Abraço

Boas
Uma pequena dúvida, ao declarar as variáveis no vba é possível criar uma para que na tabela aparece um campo da coluna com o nome ficheiro que importei

Olá Carlos,

Claro que sim e não se esqueçade adiconar tambem na "consulta adicionar"
Ainda não deu como resolvido, verifique na mensagem anterior.

Abraço

Resolvido

Boas, agradeço a ajuda pelo código da importação de XML mas surgir-me um pequeno problema, consigo importar todos os dados do ficheiro mas também preciso importar o nome do ficheiro para um campo da tabela, consegue ajudar-me no código.

Ola Carlos,

Adicione mais uma variavel, pode ser strFicheiro
Depois na parte "'Separar Campo da linha e atribuir a variavel" adicione

Código:

 strFicheiro  = objFicheiro.Name

Por fim ajuste a "'consulta acrescentar" adicionando o campo da tabela e variavel.

Abraco