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.
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
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
- 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
Última edição por XPTOS em 21/2/2020, 12:32, editado 1 vez(es)