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]Importar de arquivo XML (Problema com a vírgula)

    Compartilhe

    HARYSOHN
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 12246
    Registrado : 01/03/2011

    [Resolvido]Importar de arquivo XML (Problema com a vírgula)

    Mensagem  HARYSOHN em Qui 01 Maio 2014, 21:57

    Estou utilizando o seguinte código para importar os dados de um arquivo XML, ocorre que na parte do texto onde tem a vírgula.. desta em diante não importa.

    Código:
    '-------------------
    'Abre o arquivo  xml
    '-------------------
    Open Arquivo For Input As #1
        Do While Not EOF(1)
        nLinha = nLinha + 1
        Input #1, strLinha


    Imagem:

    [Você precisa estar registrado e conectado para ver esta imagem.]

    Importa apenas até  o número 2  antes da vírgula no texto : Fita Micropore2,5 p/cm (3M BRASIL)\
    O que fazer amigos?

    Grato pela ajuda.

    Cumprimentos.

    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 5889
    Registrado : 05/11/2009

    Re: [Resolvido]Importar de arquivo XML (Problema com a vírgula)

    Mensagem  Alexandre Neves em Sex 02 Maio 2014, 09:51

    Bom dia, amigo
    Coloca Input 1, strLinha


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo

    HARYSOHN
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 12246
    Registrado : 01/03/2011

    Re: [Resolvido]Importar de arquivo XML (Problema com a vírgula)

    Mensagem  HARYSOHN em Sex 02 Maio 2014, 15:29

    Deu Erro amigão.. Era esperado:#

    Cumprimentos.


    .................................................................................
    PILOTO
    الله أكبر Paz, Justiça e Liberdade! الله أكبر
    CLIQUE AQUI E VEJA O VÍDEO >>> BIOMETRIA EM ACCESS

    Iniciando no Access? Então veja esse tópico e também esse


    BUSCA NO FÓRUM - CLIQUE AQUI!!!

    Quando tua dúvida for RESOLVIDA, dê retorno com AGRADECIMENTO a aqueles que gastaram seu tempo em te ajudar.
    Clique no botão Resolvido logo acima do botão Enviar, do lado direito. Todos nós agradecemos.  
    [Você precisa estar registrado e conectado para ver esta imagem.]

    erinaldo
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 49
    Registrado : 27/09/2010

    Re: [Resolvido]Importar de arquivo XML (Problema com a vírgula)

    Mensagem  erinaldo em Sex 02 Maio 2014, 16:42

    ver se isto ajuda

    Do Until EOF(nFileNum)
    Line Input #nFileNum, slinetext

    If slinetext = "" Then 'se a linha é vazia, pula ela!
    GoTo passadireto
    End If

    Linha = LTrim(Replace(slinetext, vbTab, " ")) 'substitui as tabulações por espaços e corta os espaços
    Sec = Split(Linha, ">", 2, vbTextCompare) 'secciona a linha (>)
    Rotulo = Sec(0) 'pega a primeira parte da seção

    HARYSOHN
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 12246
    Registrado : 01/03/2011

    Re: [Resolvido]Importar de arquivo XML (Problema com a vírgula)

    Mensagem  HARYSOHN em Sex 02 Maio 2014, 17:20

    Opa Erinaldo... Eu estava conseguindo com o Line porém os espaços estavam sendo um problema...
    Com sua dica quanto ao VbTab Ficou perfeito!!!!!

    Obrigado a todos pela Ajuda

    Código completo

    Function ImportaXML(Arquivo As String)
    '-----------------------
    'Declaração de Variáveis
    '-----------------------
    Dim strLinha As String
    Dim strLInha1
    Dim nLinha As Integer
    Dim StrArquivo As String
    Dim StrNumCarteira As String
    Dim StrNomeBen As String
    Dim StrSenhaAut As String
    Dim dtDataHoraInt
    Dim dtDataHoraSai
    Dim lngCodigo As Long
    Dim StrDescricao As String
    Dim dblQtdRealiza As Double
    Dim dblReferencia As Double
    Dim dblValorTotal As Double
    Dim strTMP, strTMP1

    '-------------------
    'Abre o arquivo xml
    '-------------------
    Open Arquivo For Input As #1

    Do While Not EOF(1)
    Line Input #1, strLinha
    strLinha = LTrim(Replace(strLinha, vbTab, " ")) 'substitui as tabulações por espaços e corta os espaços

    If Mid(left(strLinha, 23), 2, Len(left(strLinha, 23))) = "ansTISS:numeroCarteira" Then
    strTMP = Mid(strLinha, InStrRev(strLinha, "<"))
    StrNumCarteira = Mid(strLinha, 25, InStrRev(strLinha, "<") - 25)
    ElseIf Mid(left(strLinha, 25), 2, Len(left(strLinha, 25))) = "ansTISS:nomeBeneficiario" Then
    strTMP = Mid(strLinha, InStrRev(strLinha, "<"))
    StrNomeBen = Mid(strLinha, 27, InStrRev(strLinha, "<") - 27)
    ElseIf Mid(left(strLinha, 25), 2, Len(left(strLinha, 25))) = "ansTISS:senhaAutorizacao" Then
    strTMP = Mid(strLinha, InStrRev(strLinha, "<"))
    StrSenhaAut = Mid(strLinha, 27, InStrRev(strLinha, "<") - 27)
    ElseIf Mid(left(strLinha, 27), 2, Len(left(strLinha, 27))) = "ansTISS:dataHoraInternacao" Then
    strTMP = Mid(strLinha, InStrRev(strLinha, "<"))
    dtDataHoraInt = CDate(Format(Mid(strLinha, 29, InStrRev(strLinha, "<") - 38), "mm/dd/yyyy"))
    ElseIf Mid(left(strLinha, 28), 2, Len(left(strLinha, 27))) = "ansTISS:dataHoraAtendimento" Then
    strTMP = Mid(strLinha, InStrRev(strLinha, "<"))
    dtDataHoraInt = Mid(strLinha, 30, InStrRev(strLinha, "<") - 39)
    ElseIf Mid(left(strLinha, 32), 2, Len(left(strLinha, 31))) = "ansTISS:dataHoraSaidaInternacao" Then
    strTMP = Mid(strLinha, InStrRev(strLinha, "<"))
    dtDataHoraSai = CDate(Format(Mid(strLinha, 34, InStrRev(strLinha, "<") - 43), "mm/dd/yyyy"))
    ElseIf Mid(left(strLinha, 16), 2, Len(left(strLinha, 16))) = "ansTISS:codigo>" Then
    strTMP = Mid(strLinha, InStrRev(strLinha, "<"))
    lngCodigo = Mid(strLinha, 17, InStrRev(strLinha, "<") - 17)
    ElseIf Mid(left(strLinha, 19), 2, Len(left(strLinha, 19))) = "ansTISS:descricao>" Then
    strTMP = Mid(strLinha, InStrRev(strLinha, "<"))
    'strTMP = Mid(strLinha, Len(strLinha) - 19)
    strTMP1 = left(strLinha, (Len(strLinha) - Len(strTMP)))
    If right(strLinha, 20) = "" Then
    StrDescricao = Mid(strTMP1, 20, (Len(strTMP1)))
    Else
    StrDescricao = Mid(strLinha, 20, (Len(strLinha)))
    End If
    ElseIf Mid(left(strLinha, 28), 2, Len(left(strLinha, 28))) = "ansTISS:quantidadeRealizada" Then
    strTMP = Mid(strLinha, InStrRev(strLinha, "<"))
    strTMP1 = left(strLinha, (Len(strLinha) - Len(strTMP)))
    If Len("" & strTMP1) = 0 Then
    dblQtdRealiza = 0
    Else
    dblQtdRealiza = Replace(Nz(Mid(strTMP1, 30, (Len(strTMP1))), 0), ".", ",")
    End If
    ElseIf Mid(left(strLinha, 19), 2, Len(left(strLinha, 19))) = "ansTISS:quantidade" Then
    strTMP = Mid(strLinha, InStrRev(strLinha, "<"))
    strTMP1 = left(strLinha, (Len(strLinha) - Len(strTMP)))
    If Len("" & strTMP1) = 0 Then
    dblQtdRealiza = 0
    Else
    dblQtdRealiza = Replace(Nz(Mid(strTMP1, 21, (Len(strTMP1))), 0), ".", ",")
    End If
    ElseIf Mid(left(strLinha, 15), 2, Len(left(strLinha, 15))) = "ansTISS:valor>" Then
    strTMP = Mid(strLinha, InStrRev(strLinha, "<"))
    strTMP1 = left(strLinha, (Len(strLinha) - Len(strTMP)))
    If Len("" & strTMP1) = 0 Then
    dblReferencia = 0
    Else
    dblReferencia = Replace(Nz(Mid(strTMP1, 16, (Len(strTMP1))), 0), ".", ",")
    End If
    ElseIf Mid(left(strLinha, 23), 2, Len(left(strLinha, 23))) = "ansTISS:valorUnitario>" Then
    strTMP = Mid(strLinha, InStrRev(strLinha, "<"))
    strTMP1 = left(strLinha, (Len(strLinha) - Len(strTMP)))
    If Len("" & strTMP1) = 0 Then
    dblReferencia = 0
    Else
    dblReferencia = Replace(Nz(Mid(strTMP1, 24, (Len(strTMP1))), 0), ".", ",")
    End If
    ElseIf Mid(left(strLinha, 19), 2, Len(left(strLinha, 19))) = "ansTISS:valorTotal" Then
    strTMP = Mid(strLinha, InStrRev(strLinha, "<"))
    strTMP1 = left(strLinha, (Len(strLinha) - Len(strTMP)))
    If Len("" & strTMP1) = 0 Then
    dblValorTotal = 0
    Else
    dblValorTotal = Replace(Nz(Mid(strTMP1, 21, (Len(strTMP1))), 0), ".", ",")
    End If
    '---------------------------
    'Insere os valores na tabela
    '---------------------------
    '------------------------------------------------------
    'Se a descrição não é nula e a dtDataHoraSai não é nula
    '------------------------------------------------------
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("Enviado")

    If Len("" & StrDescricao) > 0 And Len("" & dtDataHoraSai) > 0 Then
    rs.AddNew
    rs!NomeUsuário = StrNomeBen
    rs!CódUsuário = StrNumCarteira
    rs!CódGuia = StrSenhaAut
    rs!CódServiço = lngCodigo
    rs!DtAtendimento = dtDataHoraInt
    rs!DtAlta = dtDataHoraSai
    rs!NomeServiço = StrDescricao
    rs!QuantidadeServiço = dblQtdRealiza
    rs!Referencia = dblReferencia
    rs!ValorPago = dblValorTotal
    rs.Update
    '--------------------------------------------------
    'Se a descrição não é nula e a dtDataHoraSai é nula
    '--------------------------------------------------
    ElseIf Len("" & StrDescricao) > 0 And Len("" & dtDataHoraSai) = 0 Then
    rs.AddNew
    rs!NomeUsuário = StrNomeBen
    rs!CódUsuário = StrNumCarteira
    rs!CódGuia = StrSenhaAut
    rs!CódServiço = lngCodigo
    rs!DtAtendimento = CDate(dtDataHoraInt)
    rs!NomeServiço = StrDescricao
    rs!QuantidadeServiço = dblQtdRealiza
    rs!Referencia = dblReferencia
    rs!ValorPago = dblValorTotal
    rs.Update
    End If
    StrDescricao = Empty
    dblQtdRealiza = Empty
    dblReferencia = Empty
    dblValorTotal = Empty
    strTMP = Empty
    strTMP1 = Empty
    End If
    Loop
    '------------------------------------
    'Aplica na variável o nome do arquivo
    '------------------------------------
    StrArquivo = Mid(Arquivo, InStrRev(Arquivo, "\") + 1)
    '---------------------------------------------------------------------------------
    'Aplica na variável o nome do caminho que será gravado o arquivo + o nome do mesmo
    '---------------------------------------------------------------------------------
    novocaminho = CurrentProject.Path & "\ArquivosImportados\" & StrArquivo
    '--------------------------
    'Executa a cópia do arquivo
    '--------------------------
    FileCopy Arquivo, novocaminho
    '---------------
    'Fecha o arquivo
    '---------------
    Close #1
    '--------------------------
    'Deleta o arquivo de origem
    '--------------------------
    ' Kill Arquivo
    End Function


    .................................................................................
    PILOTO
    الله أكبر Paz, Justiça e Liberdade! الله أكبر
    CLIQUE AQUI E VEJA O VÍDEO >>> BIOMETRIA EM ACCESS

    Iniciando no Access? Então veja esse tópico e também esse


    BUSCA NO FÓRUM - CLIQUE AQUI!!!

    Quando tua dúvida for RESOLVIDA, dê retorno com AGRADECIMENTO a aqueles que gastaram seu tempo em te ajudar.
    Clique no botão Resolvido logo acima do botão Enviar, do lado direito. Todos nós agradecemos.  
    [Você precisa estar registrado e conectado para ver esta imagem.]

    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 5889
    Registrado : 05/11/2009

    Re: [Resolvido]Importar de arquivo XML (Problema com a vírgula)

    Mensagem  Alexandre Neves em Sex 02 Maio 2014, 20:03

    Olá amigo Hary
    Ainda bem que resolvestes, mas orientei-me pela ajuda da Microsoft (http://office.microsoft.com/pt-br/access-help/funcao-input-HA001228855.aspx)
    Abraços,


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo

    HARYSOHN
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 12246
    Registrado : 01/03/2011

    Re: [Resolvido]Importar de arquivo XML (Problema com a vírgula)

    Mensagem  HARYSOHN em Sab 03 Maio 2014, 00:05

    Opa Grande Mestre... São funções diferentes Input e input#... Eu havia tentado porém a função input retorna a quantidade de letras na variável de acordo com a quantidade especificada (em vermelho)

    MyChar = Input(1, #1)

    O problema estava na falta da instrução Line, ocorre que quando aplica o comando Line na expressão ele retorna a linha completa + tabulações..
    O que foi resolvido com a dica do colega Erinaldo.

    Valeu pela Ajuda!

    Abraços.


    .................................................................................
    PILOTO
    الله أكبر Paz, Justiça e Liberdade! الله أكبر
    CLIQUE AQUI E VEJA O VÍDEO >>> BIOMETRIA EM ACCESS

    Iniciando no Access? Então veja esse tópico e também esse


    BUSCA NO FÓRUM - CLIQUE AQUI!!!

    Quando tua dúvida for RESOLVIDA, dê retorno com AGRADECIMENTO a aqueles que gastaram seu tempo em te ajudar.
    Clique no botão Resolvido logo acima do botão Enviar, do lado direito. Todos nós agradecemos.  
    [Você precisa estar registrado e conectado para ver esta imagem.]

    erinaldo
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 49
    Registrado : 27/09/2010

    Re: [Resolvido]Importar de arquivo XML (Problema com a vírgula)

    Mensagem  erinaldo em Dom 04 Maio 2014, 18:04

    Resolvido!!! pode fechar o topico!!

    HARYSOHN
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 12246
    Registrado : 01/03/2011

    Re: [Resolvido]Importar de arquivo XML (Problema com a vírgula)

    Mensagem  HARYSOHN em Dom 04 Maio 2014, 18:31

    Já está fechado Amigão.
    Obrigado.


    .................................................................................
    PILOTO
    الله أكبر Paz, Justiça e Liberdade! الله أكبر
    CLIQUE AQUI E VEJA O VÍDEO >>> BIOMETRIA EM ACCESS

    Iniciando no Access? Então veja esse tópico e também esse


    BUSCA NO FÓRUM - CLIQUE AQUI!!!

    Quando tua dúvida for RESOLVIDA, dê retorno com AGRADECIMENTO a aqueles que gastaram seu tempo em te ajudar.
    Clique no botão Resolvido logo acima do botão Enviar, do lado direito. Todos nós agradecemos.  
    [Você precisa estar registrado e conectado para ver esta imagem.]

      Data/hora atual: Dom 04 Dez 2016, 06:00