MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Importação XML de guias.

    Compartilhe

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Dom 11 Jan 2015, 15:13

    ahteixeira, boa tarde,

    Segue exemplo semelhante ao que fiz na mensagem 39. Link abaixo.

    Como o XML que gerou o problema é do tipo guiaSP-SADT, eu achei um tanto estranho o código não importar os dados do ficheiro na integra.

    Ficheiro: ENVIO_LOTE_GUIAS_doc_40774_id_26185

    Link: [Você precisa estar registrado e conectado para ver este link.]

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Dom 11 Jan 2015, 15:40

    Olá Gomes, veja agora, foi só alterar como o outro "tipo" de ficheiro.
    Código:
                 'Inicio - guiaSP-SADT
                  'If InStr(txtLinha, "</ans:guiaSP-SADT>") > 0 And Importar = 1 Then
                   If InStr(txtLinha, "</ans:procedimentoExecutado>") > 0 And Importar = 1 Or InStr(txtLinha, "</ans:servicosExecutados>") > 0 And Importar = 1 Then
    Abraço

    extrairCampoXml_registo_v3.zip


    Última edição por ahteixeira em Sex 30 Out 2015, 11:56, editado 2 vez(es)

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Dom 11 Jan 2015, 17:18

    Prezado,

    Baixei o exemplo.

    No ficheiro ENVIO_LOTE_GUIAS_doc_40774_id_26185 o código não está importando as informações abaixo, ou seja, os dados importados não estão condizentes com os registros do ficheiro, falta informações a serem importadas.

    Codigo Descrição Valor
    60023112 - TAXA DE SALA CIRURGICA, PORTE ANESTESICO 2 - 664,23
    60022973 - TAXA DE SALA CIRURGICA, ATE 1 HORA - 221,41


    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Dom 11 Jan 2015, 17:21

    A tabela com todos os registros ficaria assim.

    [Você precisa estar registrado e conectado para ver este link.]

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Dom 11 Jan 2015, 18:48

    Ola de momento estou no telemóvel, não será ajustar conforme o outro tipo de ficheiro.
    Através da identificação do no do tipo de movimento (60023112).
    Depois dou uma vista de olhos.
    Abraço

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Seg 12 Jan 2015, 15:18

    Olá, veja se está como pretendido.
    Abraço

    extrairCampoXml_registo_v4.zip


    Última edição por ahteixeira em Sex 30 Out 2015, 11:57, editado 3 vez(es)

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Seg 12 Jan 2015, 16:16

    Olá,

    Agradeço a disponibilidade.

    Vou analisar as informações e retorno...

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Seg 12 Jan 2015, 23:33

    Olá,

    Estou a analisar o código e não tive sucesso na importação do ficheiro XML, os dados não estão condizentes com o arquivo.

    Quando eu tento importar uns 180 ficheiros para tabela o código não está distinguindo o que é guiaSP-SADT e guiaResumoInternacao.

    Vou analisar mais a fundo e tecer mais esclarecimentos...

    Grato,

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Ter 13 Jan 2015, 08:17

    Ola, estranho, com os 3 ficheiros de exemplo a fazer ao mesmo tempo, faz bem?
    Abraço

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Ter 13 Jan 2015, 09:30

    Olá,

    Não está fazendo correto. Quando olho a descrição com o valor total pago tá com erro.
    vou citar uma linha da importação como exemplo.
    Aguarde um momento.

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Qua 14 Jan 2015, 09:43

    Ok Gomes, fico no aguardo, caso tenha diferenças, envie tambem como menagem nº 19 e o xml em questão.
    Abraço

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Qua 14 Jan 2015, 10:16

    Estava mechendo ontem para enviar para o fórum, porém, minha energia acabou e não consegui enviar.

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Qua 14 Jan 2015, 15:02

    Olá Gomes, recebi a tua MP, no entanto sou da opinião que a troca de informações deve ser efetuada aqui, mantendo a razão do fórum.
    Se eventualmente tiver algum ficheiro mais sensível ou pretende proteger a privacidade, não tenho qualquer problema em receber através de MP, no entanto o diálogo deve ficar aqui para os restantes colegas.  Smile


    Bom relativamente ao tópico:

    1º Verifica se está a utilizar a ultima versão disponibilizada (pois à primeira vista o ficheiro ENVIO_LOTE_GUIAS_doc_40774_id_26185.xml está a importar conforme tabela de exemplo).

    2º Para verificar o que se está a passar necessito:
      2A - ficheiro xml: XML ENVIO_LOTE_GUIAS_doc_40113_id_26695
      2B - ficheiro que dá o erro "Erro de sintaxe na data na expressão de consulta ‘#’" a importar.

    Abraço


    Última edição por ahteixeira em Qua 14 Jan 2015, 16:42, editado 1 vez(es)

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Qua 14 Jan 2015, 15:52

    Olá, 

    Após analise do código, segue considerações do arquivo, pois o valor total do XML é 60.146,74, e está importando apenas 19.155,98.

    Apresenta (Erro de sintaxe na data na expressão de consulta ‘#’). O ficheiro que da erro é o ENVIO_LOTE_GUIAS_doc_40113_id_26695 consta no link abaixo:

    Todos os demais arquivos eu estou conseguindo importar em lotes sem problemas, porém, o XML ENVIO_LOTE_GUIAS_doc_40113_id_26695, não está sendo importado os registros pelo fato de ser ficheiro do tipo guiaResumoInternacao, e o XML possui somente dataExecucao.



    Nesse tipo de arquivo não tem dataInicioFaturamento nem dataFinalFaturamento, somente dataExecucao.

    Link Tabela: [Você precisa estar registrado e conectado para ver este link.]

    Link Campos XML: [url=https://www.dropbox.com/s/d7jfbqk47rnz3jw/Campos xml.rar?dl=0][Você precisa estar registrado e conectado para ver este link.]


    Atenciosamente,

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Qua 14 Jan 2015, 16:48

    Olá Gomes, arranjei um tempinho e acabei de testar na ultima versao, não deu erro e o total é 60146,97
    Veja a versão que está a utilizar V4 (mensagem n.º 56) o código é este (e o qual efetuei o teste):

    Código:
    Option Compare Database
    Dim meuFicheiro As String, txtLinha As String, textoLinha As String

    Private Sub Comando0_Click()
    '2014 Alvaro Teixeira - extrairCampoXml_registo_v4
    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 & "\ENVIO_LOTE_GUIAS_doc_40729_id_26191.xml"
    'meuFicheiro = Application.CurrentProject.Path & "\ENVIO_LOTE_GUIAS_doc_40765_id_26192.xml"
    'meuFicheiro = Application.CurrentProject.Path & "\ENVIO_LOTE_GUIAS_doc_40113_id_26302.xml"
    meuFicheiro = Application.CurrentProject.Path & "\ENVIO_LOTE_GUIAS_doc_40113_id_26695.xml"
        
        
    Open meuFicheiro For Input As #1
        Do Until EOF(1)
             Line Input #1, txtLinha
                  
                 '-------------- verifica tipo de ficheiro
                  If InStr(txtLinha, "<ans:guiaSP-SADT>") > 0 Then Importar = 1 ' guiaSP-SADT
                  If InStr(txtLinha, "<ans:guiaResumoInternacao>") > 0 Then Importar = 2 ' guiaResumoInternacao>
                  textoLinha = textoLinha & txtLinha
              
                  'Inicio - guiaSP-SADT
                   If InStr(txtLinha, "</ans:procedimentoExecutado>") > 0 And Importar = 1 Or InStr(txtLinha, "</ans:servicosExecutados>") > 0 And Importar = 1 Then
                     If InStr(textoLinha, "<ans:senha>") > 0 Then xCodGuia = extrairCampoXml(textoLinha, "ans:senha")
                     If InStr(textoLinha, "<ans:numeroCarteira>") > 0 Then xCodUsuario = extrairCampoXml(textoLinha, "ans:numeroCarteira")
                     If InStr(textoLinha, "<ans:nomeBeneficiario>") > 0 Then xNomeUsuario = extrairCampoXml(textoLinha, "ans:nomeBeneficiario")
                     If InStr(textoLinha, "<ans:dataExecucao>") > 0 Then xDtAtendimento = extrairCampoXml(textoLinha, "ans:dataExecucao"): 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:descricaoProcedimento>") > 0 Then xNomeServico = extrairCampoXml(textoLinha, "ans:descricaoProcedimento")
                     If InStr(textoLinha, "<ans:quantidadeExecutada>") > 0 Then xQuantidadeServico = Replace(extrairCampoXml(textoLinha, "ans:quantidadeExecutada"), ".", ",") 'alterara separador decimais
                     If InStr(textoLinha, "<ans:valorUnitario>") > 0 Then xReferencia = Replace(extrairCampoXml(textoLinha, "ans:valorUnitario"), ".", ",") 'alterara separador decimais
                     If InStr(textoLinha, "<ans:valorTotal>") > 0 Then xValorPago = Replace(extrairCampoXml(textoLinha, "ans:valorTotal"), ".", ",") 'alterara separador decimais
                     'executa consulta
                        CurrentDb.Execute "INSERT INTO Enviado (CódGuia, CódUsuário, NomeUsuário, DtAtendimento,  CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago ) SELECT " & xCodGuia _
                        & ",'" & Format(xCodUsuario, "00000000000000000") & "','" & xNomeUsuario & "', #" & Format(xDtAtendimento, "mm/dd/yyyy") & "# , " _
                        & xCodServico & ", '" & xNomeServico & "', '" & xQuantidadeServico & "', '" & xReferencia & "', '" & xValorPago & "';"
                    End If
                    'limpa
                    If InStr(txtLinha, "</ans:procedimentosExecutados>") > 0 And Importar = 1 Then textoLinha = "" 'antes processar serviços
                    If InStr(txtLinha, "</ans:guiaSP-SADT>") > 0 And Importar = 1 Then
                           Importar = 0
                           textoLinha = ""
                           xCodGuia = ""
                           xCodUsuario = ""
                           xNomeUsuario = ""
                           xDtAtendimento = ""
                           xDtAlta = ""
                           xCodServico = ""
                           xNomeServico = ""
                           xQuantidadeServico = ""
                           xReferencia = ""
                           xValorPago = ""
                    End If
                  'Fim - guiaSP-SADT
                  
                  '---------------------------------------------------------------------------------------------------------------------------------------
                  '---------------------------------------------------------------------------------------------------------------------------------------
                  
                  'Inicio - guiaResumoInternacao
                  If InStr(txtLinha, "</ans:procedimentoExecutado>") > 0 And Importar = 2 Or InStr(txtLinha, "</ans:servicosExecutados>") > 0 And Importar = 2 Then
                     If InStr(textoLinha, "<ans:senha>") > 0 Then xCodGuia = extrairCampoXml(textoLinha, "ans:senha")
                     If InStr(textoLinha, "<ans:numeroCarteira>") > 0 Then xCodUsuario = extrairCampoXml(textoLinha, "ans:numeroCarteira")
                     If InStr(textoLinha, "<ans:nomeBeneficiario>") > 0 Then xNomeUsuario = extrairCampoXml(textoLinha, "ans:nomeBeneficiario")
                     If InStr(textoLinha, "<ans:dataExecucao>") > 0 Then xDtAtendimento = extrairCampoXml(textoLinha, "ans:dataExecucao"): xDtAtendimento = Right(xDtAtendimento, 2) & "-" & Mid(xDtAtendimento, 6, 2) & "-" & Left(xDtAtendimento, 4)
                     'If InStr(textoLinha, "<ans:dataFinalFaturamento>") > 0 Then xDtAlta = extrairCampoXml(textoLinha, "ans:dataFinalFaturamento"): xDtAlta = Right(xDtAlta, 2) & "-" & Mid(xDtAlta, 6, 2) & "-" & Left(xDtAlta, 4)
                     If InStr(textoLinha, "<ans:codigoProcedimento>") > 0 Then xCodServico = extrairCampoXml(textoLinha, "ans:codigoProcedimento")
                     If InStr(textoLinha, "<ans:descricaoProcedimento>") > 0 Then xNomeServico = extrairCampoXml(textoLinha, "ans:descricaoProcedimento")
                     If InStr(textoLinha, "<ans:quantidadeExecutada>") > 0 Then xQuantidadeServico = Replace(extrairCampoXml(textoLinha, "ans:quantidadeExecutada"), ".", ",") 'alterara separador decimais
                     If InStr(textoLinha, "<ans:valorUnitario>") > 0 Then xReferencia = Replace(extrairCampoXml(textoLinha, "ans:valorUnitario"), ".", ",") 'alterara separador decimais
                     If InStr(textoLinha, "<ans:valorTotal>") > 0 Then xValorPago = Replace(extrairCampoXmlRev(textoLinha, "ans:valorTotal"), ".", ",") 'alterara separador decimais, função reverse por causa do problema do valor campo duplicado para varios nós diferentes
                     'executa consulta
                        CurrentDb.Execute "INSERT INTO Enviado (CódGuia, CódUsuário, NomeUsuário, DtAtendimento,  CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago ) SELECT " & xCodGuia _
                        & ",'" & Format(xCodUsuario, "00000000000000000") & "','" & xNomeUsuario & "', #" & Format(xDtAtendimento, "mm/dd/yyyy") & "# , " _
                        & xCodServico & ", '" & xNomeServico & "', '" & xQuantidadeServico & "', '" & xReferencia & "', '" & xValorPago & "';"
                    End If
                     'limpa
                     If InStr(txtLinha, "</ans:guiaResumoInternacao>") > 0 And Importar = 2 Then
                           Importar = 0
                           textoLinha = ""
                           xCodGuia = ""
                           xCodUsuario = ""
                           xNomeUsuario = ""
                           xDtAtendimento = ""
                           xDtAlta = ""
                           xCodServico = ""
                           xNomeServico = ""
                           xQuantidadeServico = ""
                           xReferencia = ""
                           xValorPago = ""
                     End If
                  'Fim - guiaResumoInternacao
        Loop
    Close #1
    MsgBox "Concluído", vbInformation, ""

    End Sub

    '2014 Alvaro Teixeira
    Function extrairCampoXml(strLinha As String, strNomeCampo As String)
    Dim strInicio As String
    Dim strFim As String
    strInicio = "<" & strNomeCampo & ">"
    strFim = "</" & strNomeCampo & ">"

    Dim i As Long, j As Long
        i = InStr(strLinha, strInicio)
        j = InStr(strLinha, strFim)
        extrairCampoXml = Mid(strLinha, i + Len(strInicio), j - i - Len(strInicio))
    End Function

    '2014 Alvaro Teixeira
    Function extrairCampoXmlRev(strLinha As String, strNomeCampo As String)
    Dim strInicio As String
    Dim strFim As String
    strInicio = "<" & strNomeCampo & ">"
    strFim = "</" & strNomeCampo & ">"

    Dim i As Long, j As Long
        i = InStrRev(strLinha, strInicio)
        j = InStrRev(strLinha, strFim)
        extrairCampoXmlRev = Mid(strLinha, i + Len(strInicio), j - i - Len(strInicio))
    End Function

    Abraço

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Sab 17 Jan 2015, 17:35

    Olá Gomes, como vai a situação, já testou conforme indicações!!!
    Aguardamos retorno, os utilizadores do fórum agradecem.
    Abraço.


    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Sab 17 Jan 2015, 17:47

    Olá prezado,
    Estou adaptando ele agora para trazer as informações.

    Já já eu posto o código com o exemplo.
    Minha semana foi corrida e eu não consegui mexer no decorrer da semana.

    Grato,

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Dom 18 Jan 2015, 15:26

    Olá,

    Consegui adaptar o código para trazer todos os registros dos ficheiros Sadt e Internação, porém, está faltando trazer a data de Alta quando ficheiro é de Internação. Ex: ENVIO_LOTE_GUIAS_doc_40113_id_26695.

    Link abaixo.
    [Você precisa estar registrado e conectado para ver este link.]

    Código:
    Option Compare Database
    Dim meuFicheiro As String, txtLinha As String, textoLinha As String

    Private Sub Comando0_Click()
    '2014 Alvaro Teixeira - extrairCampoXml_registo_v4
    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 & "\ENVIO_LOTE_GUIAS_doc_40729_id_26191.xml"'ok
    'meuFicheiro = Application.CurrentProject.Path & "\ENVIO_LOTE_GUIAS_doc_40765_id_26192.xml" 'não importa datas
    meuFicheiro = Application.CurrentProject.Path & "\ENVIO_LOTE_GUIAS_doc_40113_id_26695.xml" 'não importa datas
    'meuFicheiro = Application.CurrentProject.Path & "\ENVIO_LOTE_GUIAS_doc_40774_id_26185.xml" 'ok
        
    Open meuFicheiro For Input As #1
        Do Until EOF(1)
             Line Input #1, txtLinha
                  
                 '-------------- verifica tipo de ficheiro XML ---------------------
                 '-------------- verifica tipo de ficheiro XML ---------------------
                  If InStr(txtLinha, "<ans:guiaSP-SADT>") > 0 Then Importar = 1 ' guiaSP-SADT
                  If InStr(txtLinha, "<ans:guiaResumoInternacao>") > 0 Then Importar = 2 ' guiaResumoInternacao
                  'If InStr(txtLinha, "<ans:guiaResumoInternacao>") > 0 Then Importar = 3   ' guiaResumoInternacao sem data  de alta
                   textoLinha = textoLinha & txtLinha
                  
                  'Inicio - guiaSP-SADT
                  
                    If InStr(txtLinha, "</ans:procedimentoExecutado>") > 0 And Importar = 1 Or InStr(txtLinha, "</ans:servicosExecutados>") > 0 And Importar = 1 Then
                    If InStr(textoLinha, "<ans:senha>") > 0 Then xCodGuia = extrairCampoXml(textoLinha, "ans:senha")
                    If InStr(textoLinha, "<ans:numeroCarteira>") > 0 Then xCodUsuario = extrairCampoXml(textoLinha, "ans:numeroCarteira")
                    If InStr(textoLinha, "<ans:nomeBeneficiario>") > 0 Then xNomeUsuario = extrairCampoXml(textoLinha, "ans:nomeBeneficiario")
                    If InStr(textoLinha, "<ans:dataExecucao>") > 0 Then xDtAtendimento = extrairCampoXml(textoLinha, "ans:dataExecucao"): 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:descricaoProcedimento>") > 0 Then xNomeServico = extrairCampoXml(textoLinha, "ans:descricaoProcedimento")
                    If InStr(textoLinha, "<ans:quantidadeExecutada>") > 0 Then xQuantidadeServico = Replace(extrairCampoXml(textoLinha, "ans:quantidadeExecutada"), ".", ",") 'alterara separador decimais
                    If InStr(textoLinha, "<ans:valorUnitario>") > 0 Then xReferencia = Replace(extrairCampoXml(textoLinha, "ans:valorUnitario"), ".", ",") 'alterara separador decimais
                    If InStr(textoLinha, "<ans:valorTotal>") > 0 Then xValorPago = Replace(extrairCampoXml(textoLinha, "ans:valorTotal"), ".", ",") 'alterara separador decimais
                    
                     'Execulta consulta
                        
                        CurrentDb.Execute "INSERT INTO Enviado (CódGuia, CódUsuário, NomeUsuário, DtAtendimento,  CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago) SELECT " & xCodGuia _
                        & ",'" & Format(xCodUsuario, "00000000000000000") & "','" & xNomeUsuario & "', #" & Format(xDtAtendimento, "mm/dd/yyyy") & "# , " _
                        & xCodServico & ", '" & xNomeServico & "', '" & xQuantidadeServico & "', '" & xReferencia & "', '" & xValorPago & "';"
                    
                     'limpa
                    
                    End If
                    
                    If InStr(txtLinha, "</ans:procedimentoExecutado>") > 0 And Importar = 1 Or InStr(txtLinha, "</ans:servicosExecutados>") > 0 And Importar = 1 Then textoLinha = ""
                    If InStr(txtLinha, "</ans:guiaSP-SADT>") > 0 And Importar = 1 Then
                    
                    'If InStr(txtLinha, "</ans:procedimentosExecutados>") > 0 And Importar = 1 Then textoLinha = "" ' Código inserido.
                    'If InStr(txtLinha, "</ans:guiaSP-SADT>") > 0 And Importar = 1 Then ' Código inserido.
                     Importar = 0
                     textoLinha = ""
                     xCodGuia = ""
                     xCodUsuario = ""
                     xNomeUsuario = ""
                     xDtAtendimento = ""
                     xDtAlta = ""
                     xCodServico = ""
                     xNomeServico = ""
                     xQuantidadeServico = ""
                     xReferencia = ""
                     xValorPago = ""
                  
                  'Fim - guiaSP-SADT
                  
                  '---------------------------------------------------------------------------------------------------------------------------------------
                  
                  'Inicio - guiaResumoInternacao
                  
                    ElseIf InStr(txtLinha, "</ans:procedimentoExecutado>") > 0 And Importar = 2 Or InStr(txtLinha, "</ans:servicosExecutados>") > 0 And Importar = 2 Then
                    If InStr(textoLinha, "<ans:senha>") > 0 Then xCodGuia = extrairCampoXml(textoLinha, "ans:senha")
                    If InStr(textoLinha, "<ans:numeroCarteira>") > 0 Then xCodUsuario = extrairCampoXml(textoLinha, "ans:numeroCarteira")
                    If InStr(textoLinha, "<ans:nomeBeneficiario>") > 0 Then xNomeUsuario = extrairCampoXml(textoLinha, "ans:nomeBeneficiario")
                    If InStr(textoLinha, "<ans:dataExecucao>") > 0 Then xDtAtendimento = extrairCampoXml(textoLinha, "ans:dataExecucao"): 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:descricaoProcedimento>") > 0 Then xNomeServico = extrairCampoXml(textoLinha, "ans:descricaoProcedimento")
                    If InStr(textoLinha, "<ans:quantidadeExecutada>") > 0 Then xQuantidadeServico = Replace(extrairCampoXml(textoLinha, "ans:quantidadeExecutada"), ".", ",") 'alterara separador decimais
                    If InStr(textoLinha, "<ans:valorUnitario>") > 0 Then xReferencia = Replace(extrairCampoXml(textoLinha, "ans:valorUnitario"), ".", ",") 'alterara separador decimais
                    If InStr(textoLinha, "<ans:valorTotal>") > 0 Then xValorPago = Replace(extrairCampoXmlRev(textoLinha, "ans:valorTotal"), ".", ",") 'alterara separador decimais, função reverse por causa do problema do valor campo duplicado para varios nós diferentes
                    
                     'Execulta consulta
      
                        CurrentDb.Execute "INSERT INTO Enviado (CódGuia, CódUsuário, NomeUsuário, DtAtendimento,  CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago ) SELECT " & xCodGuia _
                        & ",'" & Format(xCodUsuario, "00000000000000000") & "','" & xNomeUsuario & "', #" & Format(xDtAtendimento, "mm/dd/yyyy") & "# , " _
                        & xCodServico & ", '" & xNomeServico & "', '" & xQuantidadeServico & "', '" & xReferencia & "', '" & xValorPago & "';"
                        textoLinha = ""
                    
                    
                    End If
                    
                     'limpa
                        
                    If InStr(txtLinha, "</ans:procedimentosExecutados>") > 0 And Importar = 2 Then textoLinha = "" ' Código inserido.
                    If InStr(txtLinha, "</ans:guiaResumoInternacao>") > 0 And Importar = 2 Then
                          
                           Importar = 0
                           textoLinha = ""
                           xCodGuia = ""
                           xCodUsuario = ""
                           xNomeUsuario = ""
                           xDtAtendimento = ""
                           xDtAlta = ""
                           xCodServico = ""
                           xNomeServico = ""
                           xQuantidadeServico = ""
                           xReferencia = ""
                           xValorPago = ""
                     'End If
                                    
                    ElseIf InStr(txtLinha, "</ans:procedimentoExecutado>") > 0 And Importar = 2 Or InStr(txtLinha, "</ans:servicosExecutados>") > 0 And Importar = 2 Then
                    If InStr(textoLinha, "<ans:senha>") > 0 Then xCodGuia = extrairCampoXml(textoLinha, "ans:senha")
                    If InStr(textoLinha, "<ans:numeroCarteira>") > 0 Then xCodUsuario = extrairCampoXml(textoLinha, "ans:numeroCarteira")
                    If InStr(textoLinha, "<ans:nomeBeneficiario>") > 0 Then xNomeUsuario = extrairCampoXml(textoLinha, "ans:nomeBeneficiario")
                    ElseIf InStr(textoLinha, "<ans:dataInicioFaturamento>") > 0 Then xDtAtendimento = extrairCampoXml(textoLinha, "ans:dataInicioFaturamento"): xDtAtendimento = Right(xDtAtendimento, 2) & "-" & Mid(xDtAtendimento, 6, 2) & "-" & Left(xDtAtendimento, 4)
                    ElseIf InStr(textoLinha, "<ans:dataFinalFaturamento>") > 0 Then xDtAlta = extrairCampoXml(textoLinha, "ans:dataFinalFaturamento"): xDtAlta = Right(xDtAlta, 2) & "-" & Mid(xDtAlta, 6, 2) & "-" & Left(xDtAlta, 4)
                    If InStr(textoLinha, "<ans:codigoProcedimento>") > 0 Then xCodServico = extrairCampoXml(textoLinha, "ans:codigoProcedimento")
                    If InStr(textoLinha, "<ans:descricaoProcedimento>") > 0 Then xNomeServico = extrairCampoXml(textoLinha, "ans:descricaoProcedimento")
                    If InStr(textoLinha, "<ans:quantidadeExecutada>") > 0 Then xQuantidadeServico = Replace(extrairCampoXml(textoLinha, "ans:quantidadeExecutada"), ".", ",") 'alterara separador decimais
                    If InStr(textoLinha, "<ans:valorUnitario>") > 0 Then xReferencia = Replace(extrairCampoXml(textoLinha, "ans:valorUnitario"), ".", ",") 'alterara separador decimais
                    If InStr(textoLinha, "<ans:valorTotal>") > 0 Then xValorPago = Replace(extrairCampoXmlRev(textoLinha, "ans:valorTotal"), ".", ",") 'alterara separador decimais, função reverse por causa do problema do valor campo duplicado para varios nós diferentes
                    
                     'Execulta consulta
      
                        CurrentDb.Execute "INSERT INTO Enviado (CódGuia, CódUsuário, NomeUsuário, DtAtendimento, DtAlta, CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago ) SELECT " & xCodGuia _
                        & ",'" & Format(xCodUsuario, "00000000000000000") & "','" & xNomeUsuario & "', #" & Format(xDtAtendimento, "mm/dd/yyyy") & "# , #" _
                        & Format(xDtAlta, "mm/dd/yyyy") & "# , " & xCodServico & ", '" & xNomeServico & "', '" & xQuantidadeServico & "', '" & xReferencia & "', '" & xValorPago & "';"
                        textoLinha = ""
                    End If
                    
                     'limpa
                    
                    If InStr(txtLinha, "</ans:procedimentosExecutados>") > 0 And Importar = 2 Then textoLinha = "" ' Código inserido.
                    If InStr(txtLinha, "</ans:guiaResumoInternacao>") > 0 And Importar = 2 Then
                          
                           Importar = 0
                           textoLinha = ""
                           xCodGuia = ""
                           xCodUsuario = ""
                           xNomeUsuario = ""
                           xDtAtendimento = ""
                           xDtAlta = ""
                           xCodServico = ""
                           xNomeServico = ""
                           xQuantidadeServico = ""
                           xReferencia = ""
                           xValorPago = ""
                    End If
                    
                     'Final - guiaResumoInternacao sem dataFinalFaturamento no XMl
                     '---------------------------------------------------------------------------------------------------------------------------------------
        Loop

    Close #1
    MsgBox "Concluído", vbInformation, ""

    End Sub

    '2014 Alvaro Teixeira
    Function extrairCampoXml(strLinha As String, strNomeCampo As String)
    Dim strInicio As String
    Dim strFim As String
    strInicio = "<" & strNomeCampo & ">"
    strFim = "</" & strNomeCampo & ">"

    Dim i As Long, j As Long
        i = InStr(strLinha, strInicio)
        j = InStr(strLinha, strFim)
        extrairCampoXml = Mid(strLinha, i + Len(strInicio), j - i - Len(strInicio))
    End Function
    '2014 Alvaro Teixeira
    Function extrairCampoXmlRev(strLinha As String, strNomeCampo As String)
    Dim strInicio As String
    Dim strFim As String
    strInicio = "<" & strNomeCampo & ">"
    strFim = "</" & strNomeCampo & ">"

    Dim i As Long, j As Long
        i = InStrRev(strLinha, strInicio)
        j = InStrRev(strLinha, strFim)
        extrairCampoXmlRev = Mid(strLinha, i + Len(strInicio), j - i - Len(strInicio))
    End Function

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Dom 18 Jan 2015, 21:15

    Ola, estou no telemóvel e não posso ajudar muito.
    Mas está na hora de perder o medo e fazer a alteração.
    Se reparar no código da mensagem n. 65 a instrução ja estava feita, não sei quem colocou a aspa simples para não processar.
    Inclua a seguinte linha:

    'If InStr(textoLinha, "") > 0 Then xDtAlta = extrairCampoXml(textoLinha, "ans:dataFinalFaturamento"): xDtAlta = Right(xDtAlta, 2) & "-" & Mid(xDtAlta, 6, 2) & "-" & Left(xDtAlta, 4)

    Abraço

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Dom 18 Jan 2015, 21:32

    Olá,
    Estou a dias fazendo mudanças para chegar ao que desejo.

    Vou incluir a linha sugerida para ver como fica.

    Grato,

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Dom 18 Jan 2015, 23:22

    Olá,

    Falta um detalhe mínimo para concluir o processo.

    Descobri aonde esta o erro, era no código que lê o ficheiro do tipo ans:guiaResumoInternacao, pois o código está importando para a tabela apenas os registros que possui ans:dataInicioFaturamento e ans:dataFinalFaturamento > 0 os demais registros que possui somente ans:dataExecucao são ignorados e gera erro na consulta que leva os dados para tabela por não ter ans:dataInicioFaturamento e ans:dataFinalFaturamento.

    O erro é no ficheiro meuFicheiro = Application.CurrentProject.Path & "\ENVIO_LOTE_GUIAS_doc_40113_id_26695.xml"

    Código:
    On Error Resume Next
                        'Com o erro gerado acima, a consulta não prossegue...Da erro!!!
                        CurrentDb.Execute "INSERT INTO Enviado (CódGuia, CódUsuário, NomeUsuário, DtAtendimento, DtAlta, CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago ) SELECT " & xCodGuia _
                        & ",'" & Format(xCodUsuario, "00000000000000000") & "','" & xNomeUsuario & "', #" & Format(xDtAtendimento, "mm/dd/yyyy") & "# , #" _
                        & Format(xDtAlta, "mm/dd/yyyy") & "# , " & xCodServico & ", '" & xNomeServico & "', '" & xQuantidadeServico & "', '" & xReferencia & "', '" & xValorPago & "';"
                        textoLinha = ""

    Link: [Você precisa estar registrado e conectado para ver este link.]

    Grato,

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Seg 19 Jan 2015, 09:24

    Olá Gomes, entes de verificar a questão da mensagem anteriror, explica-me o seguinte:

    1) Qual a razão das duas linhas abaixo estarem a ser excluídas (aspa simples) ao rolar o código na importação do tipo 1 ?

    Código:
                    If InStr(txtLinha, "</ans:procedimentosExecutados>") > 0 And Importar = 1 Then textoLinha = "" 'antes processar serviços
                    If InStr(txtLinha, "</ans:guiaSP-SADT>") > 0 And Importar = 1 Then


    No aguardo

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Seg 19 Jan 2015, 10:35

    Olá,

    Foi excluido por erro de minha parte, pois estava fazendo algumas modificações ontem e esqueci de habilitá-los novamente.

    Falta somente a questão anterior para sanar os problemas no código.

    Grato,

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Seg 19 Jan 2015, 10:43

    Ok,
    1) efetue a rectificação e volte a postar a última versao que tem.
    2) se possivel pode fazer uma tabela exemplificativa (como habitual) dos dados a importar, será suficiente de um paciente, pode ser o WALDOMIRO GIACOMO COMETTI

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Seg 19 Jan 2015, 11:44

    Olá,

    Segue tabela modelo de como o código deve trazer todos os dados do ficheiro.


    [Você precisa estar registrado e conectado para ver este link.]

    Grato,

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Qua 21 Jan 2015, 19:20

    Olá Gomes, está a dar erro.
    No aguardo. Abraço

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Qua 21 Jan 2015, 21:04

    Olá, boa tarde,

    Segue link novamente.

    [Você precisa estar registrado e conectado para ver este link.]

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Sex 23 Jan 2015, 12:18

    Olá Gomes, o código tem diversas aterações, já testou nos vários tipos de ficheiro e o unico ponto em que está a falhar é o relatado na mensagem nº 71?
    Aguardo retorno?

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Sex 23 Jan 2015, 12:26

    Olá,

    Sim está correto, pois o único XML que não consigo importar é o ENVIO_LOTE_GUIAS_doc_40113_id_26695.

    Os demais não da erro.

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Sex 23 Jan 2015, 12:43

    Olá, você colocou no codigo um ELSEIF e alterou a forma de como estava a controlar os ficheiros de importação,
    por isso a razão da minha questão, se está tudo mesmo a funcionar, vou verificar apenas o que pretende.
    Abraço

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Sex 23 Jan 2015, 12:47

    Olá,

    Perfeito amigo.

    Acabei de fazer novos testes e o dados dos outros ficheiros estão importando, apenas o ENVIO_LOTE_GUIAS_doc_40113_id_26695 que não consigo todos os dados.

    Qualquer eventualidade eu altero para IF.

    Grato pela atenção.

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Sex 23 Jan 2015, 14:53

    Gomes, coloque o codigo abaixo no seu ultimo exemplo postado (mensagem n. 77).
    Código:
    Option Compare Database
    Dim meuFicheiro As String, txtLinha As String, textoLinha As String

    Private Sub Comando0_Click()
    '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 & "\ENVIO_LOTE_GUIAS_doc_40729_id_26191.xml"'ok
    'meuFicheiro = Application.CurrentProject.Path & "\ENVIO_LOTE_GUIAS_doc_40765_id_26192.xml" 'não importa datas
    meuFicheiro = Application.CurrentProject.Path & "\ENVIO_LOTE_GUIAS_doc_40113_id_26695.xml" 'não importa datas
    'meuFicheiro = Application.CurrentProject.Path & "\ENVIO_LOTE_GUIAS_doc_40774_id_26185.xml" 'ok
        
    Open meuFicheiro For Input As #1
        Do Until EOF(1)
             Line Input #1, txtLinha
                  
                  If InStr(txtLinha, "<ans:guiaSP-SADT>") > 0 Then Importar = 1 ' guiaSP-SADT
                  If InStr(txtLinha, "<ans:guiaResumoInternacao>") > 0 Then Importar = 2 ' guiaResumoInternacao
                   textoLinha = textoLinha & txtLinha
              
                  'Inicio - guiaSP-SADT
                  
                    If InStr(txtLinha, "</ans:procedimentoExecutado>") > 0 And Importar = 1 Or InStr(txtLinha, "</ans:servicosExecutados>") > 0 And Importar = 1 Then
                    If InStr(textoLinha, "<ans:senha>") > 0 Then xCodGuia = extrairCampoXml(textoLinha, "ans:senha")
                    If InStr(textoLinha, "<ans:numeroCarteira>") > 0 Then xCodUsuario = extrairCampoXml(textoLinha, "ans:numeroCarteira")
                    If InStr(textoLinha, "<ans:nomeBeneficiario>") > 0 Then xNomeUsuario = extrairCampoXml(textoLinha, "ans:nomeBeneficiario")
                    If InStr(textoLinha, "<ans:dataExecucao>") > 0 Then xDtAtendimento = extrairCampoXml(textoLinha, "ans:dataExecucao"): 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:descricaoProcedimento>") > 0 Then xNomeServico = extrairCampoXml(textoLinha, "ans:descricaoProcedimento")
                    If InStr(textoLinha, "<ans:quantidadeExecutada>") > 0 Then xQuantidadeServico = Replace(extrairCampoXml(textoLinha, "ans:quantidadeExecutada"), ".", ",") 'alterara separador decimais
                    If InStr(textoLinha, "<ans:valorUnitario>") > 0 Then xReferencia = Replace(extrairCampoXml(textoLinha, "ans:valorUnitario"), ".", ",") 'alterara separador decimais
                    If InStr(textoLinha, "<ans:valorTotal>") > 0 Then xValorPago = Replace(extrairCampoXml(textoLinha, "ans:valorTotal"), ".", ",") 'alterara separador decimais
                    
                     'Execulta consulta
                        
                        CurrentDb.Execute "INSERT INTO Enviado (CódGuia, CódUsuário, NomeUsuário, DtAtendimento,  CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago) SELECT " & xCodGuia _
                        & ",'" & Format(xCodUsuario, "00000000000000000") & "','" & xNomeUsuario & "', #" & Format(xDtAtendimento, "mm/dd/yyyy") & "# , " _
                        & xCodServico & ", '" & xNomeServico & "', '" & xQuantidadeServico & "', '" & xReferencia & "', '" & xValorPago & "';"
                    
                     'limpa
                    
                    End If
                    
                    'If InStr(txtLinha, "</ans:procedimentoExecutado>") > 0 And Importar = 1 Or InStr(txtLinha, "</ans:servicosExecutados>") > 0 And Importar = 1 Then textoLinha = ""
                    'If InStr(txtLinha, "</ans:guiaSP-SADT>") > 0 And Importar = 1 Then
                    
                    If InStr(txtLinha, "</ans:procedimentosExecutados>") > 0 And Importar = 1 Then textoLinha = "" ' Código inserido, ver funcionamento.
                    If InStr(txtLinha, "</ans:guiaSP-SADT>") > 0 And Importar = 1 Then ' Código inserido, ver funcionamento.
                    
                     Importar = 0
                     textoLinha = ""
                     xCodGuia = ""
                     xCodUsuario = ""
                     xNomeUsuario = ""
                     xDtAtendimento = ""
                     xDtAlta = ""
                     xCodServico = ""
                     xNomeServico = ""
                     xQuantidadeServico = ""
                     xReferencia = ""
                     xValorPago = ""
                  
                  'Fim - guiaSP-SADT
                  
                  '---------------------------------------------------------------------------------------------------------------------------------------
                  
                  'Inicio - guiaResumoInternacao
                   ElseIf InStr(txtLinha, "</ans:procedimentoExecutado>") > 0 And Importar = 2 Or InStr(txtLinha, "</ans:servicosExecutados>") > 0 And Importar = 2 Then
                    If InStr(textoLinha, "<ans:senha>") > 0 Then xCodGuia = extrairCampoXml(textoLinha, "ans:senha")
                    If InStr(textoLinha, "<ans:numeroCarteira>") > 0 Then xCodUsuario = extrairCampoXml(textoLinha, "ans:numeroCarteira")
                    If InStr(textoLinha, "<ans:nomeBeneficiario>") > 0 Then xNomeUsuario = extrairCampoXml(textoLinha, "ans:nomeBeneficiario")
                    If InStr(textoLinha, "<ans:dataInicioFaturamento>") > 0 Then xDtAtendimento = extrairCampoXml(textoLinha, "ans:dataInicioFaturamento"): xDtAtendimento = Right(xDtAtendimento, 2) & "-" & Mid(xDtAtendimento, 6, 2) & "-" & Left(xDtAtendimento, 4)
                    
                    ' O erro de importação está nessa linha
                    If InStr(textoLinha, "<ans:dataExecucao>") > 0 Then xDtAtendimento = extrairCampoXml(textoLinha, "ans:dataExecucao"): xDtAtendimento = Right(xDtAtendimento, 2) & "-" & Mid(xDtAtendimento, 6, 2) & "-" & Left(xDtAtendimento, 4)
                    
                    If InStr(textoLinha, "<ans:dataFinalFaturamento>") > 0 Then xDtAlta = extrairCampoXml(textoLinha, "ans:dataFinalFaturamento"): xDtAlta = Right(xDtAlta, 2) & "-" & Mid(xDtAlta, 6, 2) & "-" & Left(xDtAlta, 4)
                    If InStr(textoLinha, "<ans:codigoProcedimento>") > 0 Then xCodServico = extrairCampoXml(textoLinha, "ans:codigoProcedimento")
                    If InStr(textoLinha, "<ans:descricaoProcedimento>") > 0 Then xNomeServico = extrairCampoXml(textoLinha, "ans:descricaoProcedimento")
                    If InStr(textoLinha, "<ans:quantidadeExecutada>") > 0 Then xQuantidadeServico = Replace(extrairCampoXml(textoLinha, "ans:quantidadeExecutada"), ".", ",") 'alterara separador decimais
                    If InStr(textoLinha, "<ans:valorUnitario>") > 0 Then xReferencia = Replace(extrairCampoXml(textoLinha, "ans:valorUnitario"), ".", ",") 'alterara separador decimais
                    If InStr(textoLinha, "<ans:valorTotal>") > 0 Then xValorPago = Replace(extrairCampoXmlRev(textoLinha, "ans:valorTotal"), ".", ",") 'alterara separador decimais, função reverse por causa do problema do valor campo duplicado para varios nós diferentes
                    
                     'Execulta consulta
                        'Com o erro gerado acima, a consulta não prossegue...Da erro!!!
                        CurrentDb.Execute "INSERT INTO Enviado (CódGuia, CódUsuário, NomeUsuário, DtAtendimento, DtAlta,  CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago ) SELECT " & xCodGuia _
                        & ",'" & Format(xCodUsuario, "00000000000000000") & "','" & xNomeUsuario & "', " & IIf(Len(xDtAtendimento) = 0, "'" & Null & "'", "#" & Format(xDtAtendimento, "mm/dd/yyyy") & "#") & " , " _
                        & IIf(Len(xDtAlta) = 0, "'" & Null & "'", "#" & Format(xDtAlta, "mm/dd/yyyy") & "#") & " , " & xCodServico & ", '" & xNomeServico & "', '" & xQuantidadeServico & "', '" & xReferencia & "', '" & xValorPago & "';"
                        
                        'On Error Resume Next
                        'CurrentDb.Execute "INSERT INTO Enviado (CódGuia, CódUsuário, NomeUsuário, DtAtendimento, DtAlta, CódServiço, NomeServiço, QuantidadeServiço, Referencia, ValorPago ) SELECT " & xCodGuia _
                        & ",'" & Format(xCodUsuario, "00000000000000000") & "','" & xNomeUsuario & "', #" & Format(xDtAtendimento, "mm/dd/yyyy") & "# , #" _
                        & Format(xDtAlta, "mm/dd/yyyy") & "# , " & xCodServico & ", '" & xNomeServico & "', '" & xQuantidadeServico & "', '" & xReferencia & "', '" & xValorPago & "';"
                        textoLinha = ""
                    
                   End If
                    
                     'limpa
                    If InStr(txtLinha, "</ans:procedimentosExecutados>") > 0 And Importar = 2 Then textoLinha = "" ' Código inserido.
                    If InStr(txtLinha, "</ans:guiaResumoInternacao>") > 0 And Importar = 2 Then
                          
                           Importar = 0
                           textoLinha = ""
                           xCodGuia = ""
                           xCodUsuario = ""
                           xNomeUsuario = ""
                           xDtAtendimento = ""
                           xDtAlta = ""
                           xCodServico = ""
                           xNomeServico = ""
                           xQuantidadeServico = ""
                           xReferencia = ""
                           xValorPago = ""
                    
                    End If
                    
                     'Final - guiaResumoInternacao

        Loop
    Close #1
    MsgBox "Concluído", vbInformation, ""

    End Sub

    '2014 Alvaro Teixeira
    Function extrairCampoXml(strLinha As String, strNomeCampo As String)
    Dim strInicio As String
    Dim strFim As String
    strInicio = "<" & strNomeCampo & ">"
    strFim = "</" & strNomeCampo & ">"

    Dim i As Long, j As Long
        i = InStr(strLinha, strInicio)
        j = InStr(strLinha, strFim)
        extrairCampoXml = Mid(strLinha, i + Len(strInicio), j - i - Len(strInicio))
    End Function
    '2014 Alvaro Teixeira
    Function extrairCampoXmlRev(strLinha As String, strNomeCampo As String)
    Dim strInicio As String
    Dim strFim As String
    strInicio = "<" & strNomeCampo & ">"
    strFim = "</" & strNomeCampo & ">"

    Dim i As Long, j As Long
        i = InStrRev(strLinha, strInicio)
        j = InStrRev(strLinha, strFim)
        extrairCampoXmlRev = Mid(strLinha, i + Len(strInicio), j - i - Len(strInicio))
    End Function
    No aguardo, abraço

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: [Resolvido]Importação XML de guias.

    Mensagem  XPTOS em Dom 25 Jan 2015, 00:28

    Prezado ahteixeira,

    Após adaptação verifiquei que o código funcionou muito bem.

    Obrigado pela paciência e dedicação em ajudar-me.

    ahteixeira
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3217
    Registrado : 15/03/2013

    Re: [Resolvido]Importação XML de guias.

    Mensagem  ahteixeira em Seg 26 Jan 2015, 09:27

    Olá Gomes, obrigado pelo retorno.
    Abraço

      Data/hora atual: Sab 10 Dez 2016, 06:54