MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Importar arquivo XML com condição TAG

    XPTOS
    XPTOS
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 565
    Registrado : 20/01/2014

    Importar arquivo XML com condição TAG Empty Importar arquivo XML com condição TAG

    Mensagem  XPTOS em 19/2/2020, 14:07

    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
    Anexos
    Importar arquivo XML com condição TAG AttachmentSlide1.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (258 Kb) Baixado 16 vez(es)


    Última edição por XPTOS em 21/2/2020, 12:32, editado 1 vez(es)


    .................................................................................
    Grato,
    XPTOS
    XPTOS
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 565
    Registrado : 20/01/2014

    Importar arquivo XML com condição TAG Empty Re: Importar arquivo XML com condição TAG

    Mensagem  XPTOS em 20/2/2020, 19:53

    Up


    .................................................................................
    Grato,
    XPTOS
    XPTOS
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 565
    Registrado : 20/01/2014

    Importar arquivo XML com condição TAG Empty Re: Importar arquivo XML com condição TAG

    Mensagem  XPTOS em 23/2/2020, 01:09

    Up


    .................................................................................
    Grato,
    XPTOS
    XPTOS
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 565
    Registrado : 20/01/2014

    Importar arquivo XML com condição TAG Empty Re: Importar arquivo XML com condição TAG

    Mensagem  XPTOS em 27/2/2020, 15:14

    Up

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

    Grato,


    .................................................................................
    Grato,
    avatar
    gustavo.hannouche
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 6
    Registrado : 02/06/2020

    Importar arquivo XML com condição TAG Empty Re: Importar arquivo XML com condição TAG

    Mensagem  gustavo.hannouche em 19/7/2020, 00:07

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

      Data/hora atual: 3/12/2020, 17:29