[Resolvido]Extrair Campo de XML Com Erro.

FabioPaes, bom dia,

Seu entendimento está certinho quando diz: (Realmente, somente agora que fui entender o pq... Alem de nao ter detalhes, o ele pega os dados da Aline e joga pro Gildasio)

É realmente nestas condições que vou importar os dados e caso não tenha no XML a TAG ans:detalhesGuia eu ignoro.

E então amigo, como ficou sua questão? Chegou a algum resultado?

Olá FabioPaes, bom dia,

Já consegui evoluir um pouco a respeito, logo mais eu posto o exemplo de como está o andamento do processo.

Grato,

Boa tarde a todos!

Peço desculpas pela demora em responder ao tópico, estava um tanto atarefado.

Segue pequeno exemplo que consegui evoluir, mas estou na luta porque ainda não importa todos os dados da TAG ans:relacaoGuias.

Amigo, acho que vc se perdeu no codigo...

Veja nas mensagens anteriores, eu havia lhe falado que tem que verificar se tem Detalhe na guia... Se nao tiver ignora...

Outra coisa que falei e fiz no exemplo é desmembrar os xml de cada produto, no seu caso de cada Guia.
Utilizando .xml e nao .text


Veja como ficou: dropbox.com/s/rnhm2wwnb4ztwc9/Importa%20NFe%20Xml%20Lote.zip

Importando 7 registros e ignorando os outros 7.

Verifique se nao ficou erros na importação dos dados, pois so verifiquei nome e ValorGuia.

Analise com calma os codigos...

Lembre-se é utilizado a função criado por mim e a do Ahteixeira para separar os valores...

Prezado FabioPaes, boa tarde,

Entendi o conceito do código, fiz uns testes e tem somente um pequeno detalhe.

Veja esse exemplo na guia 121495: Ao importar os dados do .XML parece que o loop na é realizado somente uma vez, pois na estrutura do .XML essa mesma guia citada tem dois registros e a importação trouxe apenas 1 registro.

Fiz um documento com print da imagem de como deveria ficar a importação desta guia 121495.

Grato,

Ola amigo, na verdade o Loop esta funcionando direitinho! Veja que há um Loop apenas na tag "ans:relacaoGuias"... Observe que ele busca todas dentro das especificações!

Como poderá haver mais de um serviço por "ans:relacaoGuias" Deverá fazer um Segundo Loop dentro da guia! Buscando todos os os detalhes "ans:detalhesGuia".

Obrigado FabioPaes,

Vou trabalhar em cima da sua dica e implementar o segundo loop em "ans:detalhesGuia" e retorno!

Olá amigos, boa tarde,

Ao tentar implementar um segundo Loop para trazer todos os registros de DetalhesGuia, o Loop fica infinito e o código trava.

Alguma dica de como resolver?

Código:

Option Compare Database
Public Function ImportaXML(LocalXml As String)
'---------------------------------------------------------------'
' Criado por FabioPaes                                          '
' Em 12/02/2017 para MAXIMOACCESS                               '
' Em caso de correçoes reportar a origem para atualizar o codigo'
'---------------------------------------------------------------'
Dim doc As DOMDocument
Dim xDet As IXMLDOMNodeList
Dim NomeArq As String
Dim DB As Database
'Dim rsCompDet As DAO.Recordset
Dim rsFor, rsProd, rsCompra, rsCompDet As DAO.Recordset
Dim xProd As String
Dim i, x, r As Integer
Diret = LocalXml
NomeArq = Dir(Diret & "*.XML", vbArchive)

Set DB = CurrentDb()
Set doc = New DOMDocument
'Buscará todos os arquivos com extenção .xml da pasta selecionada
Do While NomeArq <> ""
doc.Load (LocalXml & NomeArq) 'Pega a pasta e o nome do primeiro arquivo.
Set xDet = doc.getElementsByTagName("ans:relacaoGuias") 'TAG do XML
'------------------------------------------------------------------------'
' Dados dos Produtos
i = 0
'Aqui é o Loop que percorrerá pela Tag "det" que são os produtos..
'Buscara produto a produto, e o inserirá na nota que esta sendo importada
For Each det In xDet
On Error Resume Next
xProd = doc.getElementsByTagName("ans:relacaoGuias")(i).XML   ' xProd desmembrará o xml pegando produto a produto...
'Verifico sem a tag DetalhesGuias, se tiver eu importo, se nao ignoro
r = Nz(Len(separaEntreDuasStringsXML(xProd, "<ans:relacaoGuias>", "</ans:relacaoGuias>")), 0)

'--------------------------------------------------
'Use isto para importar tudo do arquivo XML
'r = Nz(Len(separaEntreDuasStringsXML(xProd, "<ans:relacaoGuias>", "</ans:relacaoGuias>")), 0)
'--------------------------------------------------

If r > 4 Then 'Verifica se a contagem dua mais de 4 caracteres, se tiver signfica que tem dados a importar, se nao ignora
'Insere o produto cadastrado na Nota de compra
        
        Set rsCompDet = DB.OpenRecordset("Recebido")
 [color=#ff0000]       Do While rsCompDet.EOF
            rsCompDet.AddNew
            rsCompDet!nomeBeneficiario = Replace(separaEntreDuasStringsXML(xProd, "<ans:nomeBeneficiario>", "</ans:nomeBeneficiario>"), ".", ",")
            rsCompDet!senhaAutorizacao = Replace(separaEntreDuasStringsXML(xProd, "<ans:numeroGuiaPrestador>", "</ans:numeroGuiaPrestador>"), ".", ",")
            rsCompDet!numeroCarteira = Replace(separaEntreDuasStringsXML(xProd, "<ans:numeroCarteira>", "</ans:numeroCarteira>"), ".", ",")
            rsCompDet!dataHoraInternacao = Replace(separaEntreDuasStringsXML(xProd, "<ans:dataInicioFat>", "</ans:dataInicioFat>"), ".", ",")
            rsCompDet!codigo = Replace(separaEntreDuasStringsXML(xProd, "<ans:codigoProcedimento>", "</ans:codigoProcedimento>"), ".", ",")
            rsCompDet!descricao = Replace(separaEntreDuasStringsXML(xProd, "<ans:descricaoProcedimento>", "</ans:descricaoProcedimento>"), ".", ",")
            rsCompDet!quantidade = Replace(separaEntreDuasStringsXML(xProd, "<ans:qtdExecutada>", "</ans:qtdExecutada>"), ".", ",")
            rsCompDet!valorUnitario = Replace(separaEntreDuasStringsXML(xProd, "<ans:valorLiberado>", "</ans:valorLiberado>"), ".", ",")
            rsCompDet!valorTotal = Replace(separaEntreDuasStringsXML(xProd, "<ans:valorLiberado>", "</ans:valorLiberado>"), ".", ",")
        rsCompDet.Update
        rsCompDet.MoveNext
        Loop
 [/color]       rsCompDet.Close
        Set rsCompDet = Nothing

End If
i = i + 1
Next

'Loop dos arquivos, pega o proximo arquivo
NomeArq = Dir()
Loop
MsgBox "Todos os XMLs da pasta selecionada Foram Importados com Sucesso! " & vbNewLine & "Verifique as Notas lançadas!!!", vbInformation, "Sucesso!!!"
DB.Close
Set DB = Nothing
End Function


Up.

Up.

Up.

Up.

Up.

Up.

Estou subindo o tópico, pois estou na eminencia de colocar um segundo loop no código, porém, o mesmo está infinito, não tem ponto de interrupção.

Agradeço a ajuda dos colegas!.

Up.
Não posso desistir dessa instrução, pois é muito importante para minha rotina diária.

Grato aos senhores.

Amigo, Quantos registros devem ser importados mesmo, pois no exemplo que mandou tem uma planilha Excel com 20 registros...

Posta como devem ser importados...


Pedia ao amigo que desse sequencia ao tópico, pois fica complicado eu postar uma correção e demorar dias para vc responder... Quando isso acontece eu tenho que voltar a compreender todo o código, rele as mensagens anteriores para dar sequencia!

Claro amigo,

Peço desculpas nesse caso, pois estava implantando meu sistema em outro cliente me deu alguma dor de cabeça.

Vou postar novamente.

Mas poste agora, para que possamos ver isso ainda hj! Ja que estarei me ausentando do Fórum por um período longo!

Olá,

Deixei um ficheiro na Mensagem nº12, deste mesmo tópico.

Grato,

Amigo, segue o que Eu Acho que é o que precisa.

dropbox.com/s/p6lkxrmdd4fut9d/Importa%20NFe%20Xml%20Lote.rar


Veja a questão dos valores, pois não entendi bem quais valores queria de cada serviço!

Olá FabioPaes,

Boa noite!

É justamente isso que precisava importar nesse modelo de .XML, agradeço sua cordial compreensão e colaboração.

PS: A questão dos valores já indiquei no código os campos que preciso.

Código:


rsCompDet!valorUnitario = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:valorLiberado>", "</ans:valorLiberado>"), ".", ",")
rsCompDet!valorTotal = Replace(separaEntreDuasStringsXML(xProd, "<ans:valorLiberado>", "</ans:valorLiberado>"), ".", ",")


Att,

Grato pelo retorno amigo, até a próxima se Deus Quiser!

Estude e entenda o que foi feito com esse código amigo...

Certamente,
Vou depurar linha a linha para compreender melhor.