David Morgado

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

Como faço para ativar isso?

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.