[Resolvido]Importar arquivo XML com condição TAG

Amigos,
Bom dia!

Preciso de uma ajuda dos feras.

Tenho o código abaixo que faz a importação do XML capturando todos os produtos que tem dentro da TAG , acontece o seguinte, alguns outros registros não tem a referida TAG, como segue na imagem.

Código:

Open Arquivo For Input As #1
        
Dim doc, docTmp As DOMDocument
Dim xDet As IXMLDOMNodeList
Dim NomeArq As String
Dim db As Database
Dim rsFor, rsProd, rsCompra, rsCompDet As DAO.Recordset
Dim xProd As String
Dim xDetTmp As String
Dim I, x, R, P As Integer
Dim F As Variant
'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 (Arquivo) 'Pega a pasta e o nome do primeiro arquivo.
Set xDet = doc.getElementsByTagName("ans:relacaoGuias") 'TAG do XML
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
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:detalhesGuia>", "</ans:detalhesGuia")), 0)
'Insere registros na tabela

            F = Split(xProd, "<ans:detalhesGuia>")
            For P = 1 To UBound(F)
                xDetTmp = F(P)
                Set rsCompDet = db.OpenRecordset("Recebido")
                
                    rsCompDet.AddNew
                    rsCompDet!nomeBeneficiario = Replace(separaEntreDuasStringsXML(xProd, "<ans:nomeBeneficiario>", "</ans:nomeBeneficiario>"), ".", ",")
                    
                    If [Forms]![logon]![cboConvenio] = "SAO BERNARDO SAUDE" Then
                    rsCompDet!senhaAutorizacao = Replace(separaEntreDuasStringsXML(xProd, "<ans:numeroGuiaOperadora>", "</ans:numeroGuiaOperadora>"), ".", ","): rsCompDet!senhaAutorizacao = right(rsCompDet!senhaAutorizacao,
                    
                    ElseIf [Forms]![logon]![cboConvenio] = "PREMIUM SAUDE" Then
                    rsCompDet!senhaAutorizacao = Replace(separaEntreDuasStringsXML(xProd, "<ans:numeroGuiaPrestador>", "</ans:numeroGuiaPrestador>"), ".", ","): rsCompDet!senhaAutorizacao = right(rsCompDet!senhaAutorizacao, 7)
                    Else
                    rsCompDet!senhaAutorizacao = Replace(separaEntreDuasStringsXML(xProd, "<ans:numeroGuiaPrestador>", "</ans:numeroGuiaPrestador>"), ".", ",")
                    End If
                      
                    rsCompDet!numeroCarteira = Replace(separaEntreDuasStringsXML(xProd, "<ans:numeroCarteira>", "</ans:numeroCarteira>"), ".", "")
                    rsCompDet!dataHoraInternacao = Replace(separaEntreDuasStringsXML(xProd, "<ans:dataInicioFat>", "</ans:dataInicioFat>"), ".", ",")
                    rsCompDet!codigo = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:codigoProcedimento>", "</ans:codigoProcedimento>"), ".", ","): rsCompDet!codigo = right(rsCompDet!codigo,
                    rsCompDet!descricao = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:descricaoProcedimento>", "</ans:descricaoProcedimento>"), ".", ",")
                    rsCompDet!quantidade = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:qtdExecutada>", "</ans:qtdExecutada>"), ".", ",")
                    rsCompDet!valorUnitario = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:valorLiberado>", "</ans:valorLiberado>"), ".", ",")
                    'rsCompDet!valorUnitario = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:valorInformado>", "</ans:valorInformado>"), ".", ",")
                    rsCompDet!valorTotal = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:valorLiberado>", "</ans:valorLiberado>"), ".", ",")
                    rsCompDet!CodGlosaTISS = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:tipoGlosa>", "</ans:tipoGlosa>"), ".", ",")
                rsCompDet.Update
                rsCompDet.Close
                Set rsCompDet = Nothing
            Next

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

Aonde eu posso inserir um IF para ler o trecho do arquivo que tem a TAG ans:detalhesGuia e outro para ler o trecho que não tem essa TAG, pois vou precisar de todo conteúdo.

Grato

Up

Up

Up

Agradeço ajuda dos amigos para tentar resolver esse problema.

Grato,

Boa noite amigo. Você conseguiu importar uma xml com produtos para o access?

Pessoal,
Tenho que importar varias contas de um XML e uso o código abaixo:
Porém, estou com o seguinte problema, tenho duas TAGs distintas e teria que importar as duas e vai apenas uma.

Código:

Set db = CurrentDb()
Set doc = New DOMDocument
'Buscará todos os arquivos com extenção .xml da pasta selecionada
'Do While NomeArq <> ""
doc.Load (Arquivo) 'Pega a pasta e o nome do primeiro arquivo.
Set xDet = doc.getElementsByTagName("ans:relacaoGuias") 'TAG do XML
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
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:detalhesGuia>", "</ans:detalhesGuia")), 0)
'Insere registros na tabela

            F = Split(xProd, "<ans:detalhesGuia>")
            For P = 1 To UBound(F)
                xDetTmp = F(P)
                Set rsCompDet = db.OpenRecordset("Recebido")
                
                    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(xDetTmp, "<ans:codigoProcedimento>", "</ans:codigoProcedimento>"), ".", ","): rsCompDet!codigo = right(rsCompDet!codigo,
                    rsCompDet!descricao = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:descricaoProcedimento>", "</ans:descricaoProcedimento>"), ".", ",")
                    rsCompDet!quantidade = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:qtdExecutada>", "</ans:qtdExecutada>"), ".", ",")
                    rsCompDet!valorUnitario = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:valorLiberado>", "</ans:valorLiberado>"), ".", ",")
                    'rsCompDet!valorUnitario = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:valorInformado>", "</ans:valorInformado>"), ".", ",")
                    rsCompDet!valorTotal = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:valorLiberado>", "</ans:valorLiberado>"), ".", ",")
                    rsCompDet!CodGlosaTISS = Replace(separaEntreDuasStringsXML(xDetTmp, "<ans:tipoGlosa>", "</ans:tipoGlosa>"), ".", ",")
                rsCompDet.Update
                rsCompDet.Close
                Set rsCompDet = Nothing
            Next


Código:

<ans:relacaoGuias>
              <ans:numeroGuiaPrestador>xxxxx</ans:numeroGuiaPrestador>
              <ans:numeroGuiaOperadora>xxxxx</ans:numeroGuiaOperadora>
              <ans:senha>xxxxx</ans:senha>
              <ans:nomeBeneficiario>xxxxx</ans:nomeBeneficiario>
              <ans:numeroCarteira>xxxxx</ans:numeroCarteira>
              <ans:dataInicioFat>2020-12-23</ans:dataInicioFat>
              <ans:situacaoGuia>6</ans:situacaoGuia>
              <ans:valorInformadoGuia>0</ans:valorInformadoGuia>
              <ans:valorProcessadoGuia>80</ans:valorProcessadoGuia>
              <ans:valorLiberadoGuia>80</ans:valorLiberadoGuia>
            </ans:relacaoGuias>

Código:

<ans:relacaoGuias>
              <ans:numeroGuiaPrestador>xxxxx</ans:numeroGuiaPrestador>
              <ans:numeroGuiaOperadora>xxxxx</ans:numeroGuiaOperadora>
              <ans:senha>xxxxx</ans:senha>
              <ans:nomeBeneficiario>xxxxx</ans:nomeBeneficiario>
              <ans:numeroCarteira>xxxxx</ans:numeroCarteira>
              <ans:dataInicioFat>2020-12-23</ans:dataInicioFat>
              <ans:motivoGlosaGuia>
                <ans:codigoGlosa>1303</ans:codigoGlosa>
                <ans:descricaoGlosa>xxxxx</ans:descricaoGlosa>
              </ans:motivoGlosaGuia>
              <ans:situacaoGuia>6</ans:situacaoGuia>
              <ans:detalhesGuia>
                <ans:sequencialItem />
                <ans:dataRealizacao>2020-09-04</ans:dataRealizacao>
                <ans:procedimento>
                  <ans:codigoTabela>22</ans:codigoTabela>
                  <ans:codigoProcedimento>111111111</ans:codigoProcedimento>
                  <ans:descricaoProcedimento>xxxxx</ans:descricaoProcedimento>
                </ans:procedimento>
                <ans:valorInformado>22.73</ans:valorInformado>
                <ans:qtdExecutada>1</ans:qtdExecutada>
                <ans:valorProcessado>22.74</ans:valorProcessado>
                <ans:valorLiberado>22.74</ans:valorLiberado>
                <ans:relacaoGlosa>
                  <ans:valorGlosa>0</ans:valorGlosa>
                  <ans:tipoGlosa>3040</ans:tipoGlosa>
                </ans:relacaoGlosa>
              </ans:detalhesGuia>
              <ans:valorInformadoGuia>22.73</ans:valorInformadoGuia>
              <ans:valorProcessadoGuia>22.74</ans:valorProcessadoGuia>
              <ans:valorLiberadoGuia>22.74</ans:valorLiberadoGuia>
            </ans:relacaoGuias>
           

           

Ou seja, neste mesmo arquivo tenho contas com a TAG  e outras sem ela. Mas consigo importar somente quem tem a  .

Como posso tratar?

Pessoal, boa noite!

Estou com uma dúvido em inserir uma codição para importar os registro de um XML.

Conforme trecho abaixo, o arquivo possui a tag pai (ans:relacaoGuias), dentro desta tag eu busco a tag filha (ans:detalhesGuia) para recuperar os registros das contas.

Toda conta que possui a tag filha (ans:detalhesGuia) eu consigo importar os registros perfeitamente.

Meu problema é que algumas contas tem somente a tag (ans:relacaoGuias) e eu não consigo importar esses registros do XML.

Alguém pode me sugerir como posso tratar?

Código:


PRIMEIRA CONDIÇÃO IMPORTA PERFEITAMENTE:
<ans:relacaoGuias> 'TAG PAI
<ans:numeroGuiaPrestador>xxxxx</ans:numeroGuiaPrestador>
<ans:numeroGuiaOperadora>xxxxx</ans:numeroGuiaOperadora>
<ans:senha>xxxxx</ans:senha>
<ans:nomeBeneficiario>xxxxx</ans:nomeBeneficiario>
<ans:numeroCarteira>xxxxx</ans:numeroCarteira>
<ans:dataInicioFat>2020-12-23</ans:dataInicioFat>
<ans:motivoGlosaGuia>
<ans:codigoGlosa>1303</ans:codigoGlosa>
<ans:descricaoGlosa>xxxxx</ans:descricaoGlosa>
</ans:motivoGlosaGuia>
<ans:situacaoGuia>6</ans:situacaoGuia>[/color]

<ans:detalhesGuia>'TAG ONDE CONTEM OS REGISTROS FILHOS
<ans:sequencialItem />
<ans:dataRealizacao>2020-09-04</ans:dataRealizacao>
<ans:procedimento>
<ans:codigoTabela>22</ans:codigoTabela>
<ans:codigoProcedimento>111111111</ans:codigoProcedimento>
<ans:descricaoProcedimento>xxxxx</ans:descricaoProcedimento>
</ans:procedimento>
<ans:valorInformado>22.73</ans:valorInformado>
<ans:qtdExecutada>1</ans:qtdExecutada>
<ans:valorProcessado>22.74</ans:valorProcessado>
<ans:valorLiberado>22.74</ans:valorLiberado>
<ans:relacaoGlosa>
<ans:valorGlosa>0</ans:valorGlosa>
<ans:tipoGlosa>3040</ans:tipoGlosa>
</ans:relacaoGlosa>
</ans:detalhesGuia>
<ans:valorInformadoGuia>22.73</ans:valorInformadoGuia>
<ans:valorProcessadoGuia>22.74</ans:valorProcessadoGuia>
<ans:valorLiberadoGuia>22.74</ans:valorLiberadoGuia>
</ans:relacaoGuias>

SEGUNDA CONDIÇÃO NÃO FAZ A IMPORTAÇÃO:
<ans:relacaoGuias>
<ans:numeroGuiaPrestador>xxxxx</ans:numeroGuiaPrestador>
<ans:numeroGuiaOperadora>xxxxx</ans:numeroGuiaOperadora>
<ans:senha>xxxxx</ans:senha>
<ans:nomeBeneficiario>xxxxx</ans:nomeBeneficiario>
<ans:numeroCarteira>xxxxx</ans:numeroCarteira>
<ans:dataInicioFat>2020-12-23</ans:dataInicioFat>
<ans:situacaoGuia>6</ans:situacaoGuia>
<ans:valorInformadoGuia>0</ans:valorInformadoGuia>
<ans:valorProcessadoGuia>80</ans:valorProcessadoGuia>
<ans:valorLiberadoGuia>80</ans:valorLiberadoGuia>
</ans:relacaoGuias>
[/color]

Código:

'2014 Alvaro Teixeira - extrairCampoXml_registo_v6 - 23-01-2015
Dim Importar, Proce As Integer
textoLinha = ""
Importar = 0

Dim xCodGuia$ 'senha
Dim xCodUsuario$ 'numeroCarteira
Dim xNomeUsuario$ 'nomeBeneficiario
Dim xDtAtendimento$ 'dataInicioFaturamento - dataExecucao
Dim xDtAlta$ 'dataFinalFaturamento
Dim xCodServico$ 'codigoProcedimento
Dim xNomeServico$ 'descricaoProcedimento
Dim xQuantidadeServico$ 'quantidadeExecutada
Dim xReferencia$ 'valorUnitario
Dim xValorPago$ 'valorTotal


meuFicheiro = Application.CurrentProject.Path & "\500000019_DemonstrativoAnalise_168218.xml"

Open meuFicheiro For Input As #1
Do Until EOF(1)
Line Input #1, txtLinha

    If InStr(txtLinha, "</ans:relacaoGuias>") > 0 Then Importar = 1 'TAG PAI
        textoLinha = textoLinha & txtLinha
    
        If InStr(txtLinha, "</ans:detalhesGuia>") > 0 And Importar = 1 Then 'TAG FILHO
        If InStr(textoLinha, "<ans:numeroGuiaPrestador>") > 0 Then xCodGuia = extrairCampoXml(textoLinha, "ans:numeroGuiaPrestador")
        If InStr(textoLinha, "<ans:nomeBeneficiario>") > 0 Then xNomeUsuario = extrairCampoXml(textoLinha, "ans:nomeBeneficiario")
        If InStr(textoLinha, "<ans:numeroCarteira>") > 0 Then xCodUsuario = extrairCampoXml(textoLinha, "ans:numeroCarteira")
        If InStr(textoLinha, "<ans:dataInicioFat>") > 0 Then xDtAtendimento = extrairCampoXml(textoLinha, "ans:dataInicioFat"): xDtAtendimento = right(xDtAtendimento, 2) & "-" & Mid(xDtAtendimento, 6, 2) & "-" & left(xDtAtendimento, 4)
        If InStr(textoLinha, "<ans:codigoProcedimento>") > 0 Then xCodServico = extrairCampoXml(textoLinha, "ans:codigoProcedimento")
        If InStr(textoLinha, "<ans:qtdExecutada>") > 0 Then xQuantidadeServico = extrairCampoXml(textoLinha, "ans:qtdExecutada"): xQuantidadeServico = left(xQuantidadeServico, 2)
        If InStr(textoLinha, "<ans:descricaoProcedimento>") > 0 Then xNomeServico = extrairCampoXml(textoLinha, "ans:descricaoProcedimento")
        If InStr(textoLinha, "<ans:valorLiberado>") > 0 Then xReferencia = Replace(extrairCampoXml(textoLinha, "ans:valorLiberado"), ".", ",") 'alterara separador decimais
        If InStr(textoLinha, "<ans:valorLiberado>") > 0 Then xValorPago = Replace(extrairCampoXml(textoLinha, "ans:valorLiberado"), ".", ",") 'alterara separador decimais
        
        'Execulta consulta
        CurrentDb.Execute "INSERT INTO tblBradesco (CódUsuário, CódGuia, NomeUsuário, DtAtendimento, CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago) SELECT '" _
        & Format(xCodUsuario, "000000000000000") & "', '" & xCodGuia & "', '" & xNomeUsuario & "', " & IIf(Len(xDtAtendimento) = 0, "'" & Null & "'", "#" & Format(xDtAtendimento, "mm/dd/yyyy") & "#") & " , '" & xCodServico & "', '" & xNomeServico & "', '" _
        & xQuantidadeServico & "', '" & xReferencia & "', '" & xValorPago & "';"
        textoLinha = ""
                
    End If
    
    If InStr(txtLinha, "</ans:relacaoGuias>") > 0 And Importar = 1 Then textoLinha = ""

Loop
'atribuir às variaveis temporarias os campos do XML

Close #1
MsgBox "Concluído com sucesso!", vbInformation + vbCritical, ""

Olá a todos!

Para facilitar o entendimento dos amigos, deixo pequeno exemplo de testes.

Link: Baixar arquivo

PS: Descompactar na área de trabalho.

Up

Up

Up

Up

Tópicos fundidos.