[Importar ficheiro xml para tabela acess]

Alguém me pode ajudar a a importar o ficheiro xml para o acess através do vba?

obrigada

[Função registralinhas]

Como faço para ativar isso?

 

[Função registralinhas]

Estou tentando importar dados de um ficheiro xml para a base de dados através do Vba.

Consegui fazer a mesma coisa com ficheiro .txt mas estou com dificuldades com o xml, criei um botão num formulário e ao clicar no botão ele importa dados para a tabela de uma pasta Chamada Ficheiro para outra pasta tratados.

Ficheiro xml:

<?xml version="1.0" encoding="ISO-8859-1"?>
<!-- created by ARS smart 0000034131 -->
<suppliers>

<data ID="55" S="2" Q="0" V="31710" V2="500" Long="-25721108" Lat="37770558" Avg="1" Dairy="1" Ves="1" Name="*****"/>
<data ID="59" S="2" Q="0" V="13240" V2="500" Long="-25245918" Lat="37769905" Avg="1" Dairy="1" Ves="1" Name="*****"/>
<data ID="71" S="2" Q="0" V="9450" V2="500" Long="-25694821" Lat="37814465" Avg="1" Dairy="1" Ves="1" Name="*******"/>
<data ID="77" S="2" Q="0" V="33372" V2="500" Long="-25417173" Lat="37805191" Avg="1" Dairy="1" Ves="1" Name="********"/>
<data ID="104" S="2" Q="0" V="24390" V2="500" Long="-25794643" Lat="37824955" Avg="1" Dairy="1" Ves="1" Name="******"/>
<data ID="118" S="2" Q="0" V="35149" V2="500" Long="-25833499" Lat="37857799" Avg="1" Dairy="1" Ves="1" Name="*********"/>

</suppliers>

Código de vba acess

Queria tentar adapatar o código para que consigo realizar a mesma função mas com ficheiros XML(como está referido os dados acima)

Function LeFicheiros()
    Dim objFSO, objPasta, objFicheiros, objFicheiro, objTextFile, objFSOtxt 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:\Volumes\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 objFSOtxt = CreateObject("Scripting.FileSystemObject")  ' file system object
        Set objTextFile = objFSOtxt.OpenTextFile("C:\Volumes\Ficheiros\" & objFicheiro.Name, 1) ' abertura do ficheiro nas posicao pretendida, com o 1 no final por defeito
        
        Do While objTextFile.atendofstream = False ' faz enquanto não 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:\Volumes\Ficheiros\" & objFicheiro.Name, "C:\Volumes\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
        
    End If
    
    
    
    rstDados.AddNew ' cria uma nova linha em branco na tabela
    rstDados![Manhã] = 0
    rstDados![Tarde] = 0
    rstDados![Sistema] = Left(strFicheiro, InStr(strFicheiro, "_") - 1) ' para ter o nome até à posicao anterior do primeiro underscore
    rstDados![Nome] = DLookup("Posto_ou_Viatura", "Sistemas", "[Sistemas] = '" & rstDados![Sistema] & "'")
    rstDados![Tipo Recolha] = strDelimitado(0) ' registar dados na posicao 0, no tipo de recolha
    rstDados![Data] = DateSerial(Left(strDelimitado(1), 4), Mid(strDelimitado(1), 6, 2), Right(strDelimitado(1), 2))  'funcao para virar a data ao contrário
    rstDados![Hora] = strDelimitado(2)
    If rstDados![Hora] < TimeSerial(12, 0, 0) Then
        rstDados![Manhã] = Replace(strDelimitado(5), ".", ",")
    Else
        rstDados![Tarde] = Replace(strDelimitado(5), ".", ",")
    End If
    rstDados![SERCLA] = strDelimitado(3)
    rstDados![Número da Recolha] = strDelimitado(4)
    'rstDados![Volume] = Replace(strDelimitado(5), ".", ",")
    rstDados![Temperatura Amostra] = Replace(strDelimitado(6), ".", ",")
    rstDados![Temperatura Mínima] = Replace(strDelimitado(7), ".", ",")
    rstDados![Temperatura Média] = Replace(strDelimitado(8), ".", ",")
    rstDados![Temperatura Máxima] = Replace(strDelimitado(9), ".", ",")
    'If strDelimitado(10) <> "-" Then rstDados![Código Frasco] = strDelimitado(10)
    rstDados![Código Inter] = strDelimitado(11)
    'rstDados![Volume Estimado] = strDelimitado(12)
    rstDados![Código Final Posto] = strDelimitado(13)
    If Left(strFicheiro, 6) = "Camiao" Then
        rstDados![Código Final Camião] = strDelimitado(14)
    End If

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

End Function
 

Se tiver outra forma de importar esse ficheiro XML para o acess agredeço a quem puder ajudar.