locked
Problemas de Caracteres especiais no Access RRS feed

  • Pergunta

  • Ola colegas.

     

    estou com um problema e não consegui arrumar uma solução ainda.

    pois todas as vezes que importo o arquivo texto via a rotina que criei, os campos textos que tem acentuação ou alguma coisa do tipo, ficam com caracteres especiais, o que é ruim ao gerar um relatorio.

    sei que existe o import do proprio access, mas não quero usa-lo, pois estou terminando um sistema e vou desabilitar o uso das barras de tarefas.

    outra coisa importante a ser levado em consideração, é o desempenho, pois os arquivos txt que importo tem em media 50mil registros.

    não sei como resolver se alguem puder me dar uma ajuda eu agradeceria muito.

    meu bd foi gerado no access 2010

    a rotina:

     

    Private Sub btnImportar_Click()

     On Error GoTo TrataErro

     Dim DB As DAO.Database
     Dim RS As DAO.Recordset
     Dim RS1 As DAO.Recordset
     Dim RS2 As DAO.Recordset
     Dim Linha As String
     Dim Posicao1 As Integer
     Dim Posicao2 As Integer
     Dim Tamanho As Integer
     Dim Cdveic As Integer
     Dim Cdcliente As Integer
     Dim Dtmovgps As Date
     Dim NmLogradouro As String
     Dim NrLog As String
     Dim NmBairro As String
     Dim NrCep As String
     Dim NmCidade As String
     Dim Sguf As String
     Dim Temp As Integer
     Dim CdErro As Integer
     Dim DsErro As String

     

     

     If Len(Me.txtNomeArq & vbNullString) = 0 Then ' Testa se txtNomeArq contém alguma coisa
     MsgBox "Informe o nome do arquivo a ser importado", vbExclamation + vbOKOnly, "Vazio"
     Me.txtNomeArq.SetFocus
     Exit Sub
     End If


     If Len(Dir(Me.txtNomeArq)) = 0 Then ' Testa a existência do arquivo
     MsgBox "O arquivo não existe!!!", vbCritical + vbOKOnly, "Erro"
     Me.txtNomeArq.SetFocus
     Exit Sub
     End If


     Open Me.txtNomeArq For Input As #1 ' Abre o arquivo a ser importado

     Posicao2 = InStr(1, Me.txtNomeArq, ".txt")
     Posicao1 = Posicao2 - 16

     NomeArqCarregado = Trim(Mid(Me.txtNomeArq, Posicao1, 20))
     MsgBox NomeArqCarregado, vbExclamation + vbOKOnly, "Vazio"


     Set DB = CurrentDb
     Set RS = DB.OpenRecordset("TabelaPosicao")
     Set RS1 = DB.OpenRecordset("ArquivosCarregados")
     Set RS2 = DB.OpenRecordset("TbErro")

     Line Input #1, Linha

     While Not EOF(1)
     Line Input #1, Linha ' Lê uma linha do arquivo texto

     Posicao1 = 1
     Posicao2 = InStr(1, Linha, ";")
     Cdveic = CInt(Mid(Linha, Posicao1, (Posicao2 - Posicao1)))
     Posicao1 = (Posicao2 + 1)
     Posicao2 = InStr(Posicao1, Linha, ";")
     Cdcliente = CInt(Mid(Linha, Posicao1, (Posicao2 - Posicao1)))
     Posicao1 = (Posicao2 + 1)
     Posicao2 = InStr(Posicao1, Linha, ";")
     Dtmovgps = CVDate(Mid(Linha, Posicao1, (Posicao2 - Posicao1)))
     Posicao1 = (Posicao2 + 1)
     Posicao2 = InStr(Posicao1, Linha, ";")
     NmLogradouro = Mid(Linha, Posicao1, (Posicao2 - Posicao1))
     Posicao1 = (Posicao2 + 1)
     Posicao2 = InStr(Posicao1, Linha, ";")
     NrLog = Mid(Linha, Posicao1, (Posicao2 - Posicao1))
     Posicao1 = (Posicao2 + 1)
     Posicao2 = InStr(Posicao1, Linha, ";")
     NmBairro = Mid(Linha, Posicao1, (Posicao2 - Posicao1))
     Posicao1 = (Posicao2 + 1)
     Posicao2 = InStr(Posicao1, Linha, ";")
     NrCep = Mid(Linha, Posicao1, (Posicao2 - 1))
     Posicao1 = (Posicao2 + 1)
     Posicao2 = InStr(Posicao1, Linha, ";")
     NmCidade = Mid(Linha, Posicao1, (Posicao2 - Posicao1))
     Posicao1 = (Posicao2 + 1)
     Sguf = Mid(Linha, Posicao1, 5)

     With RS
     .AddNew
     !cd_veic = Cdveic
     !cd_cliente = Cdcliente
     !dt_mov_gps = Dtmovgps
     !nm_logradouro = NmLogradouro
     !nr_log = NrLog
     !nm_bairro = NmBairro
     !nr_cep = NrCep
     !nm_cidade = NmCidade
     !sg_uf = Sguf
     !arquivo = NomeArqCarregado
     .Update
     End With

     

     Wend

     With RS1
     .AddNew
     !NomeDoArquivo = NomeArqCarregado
     !NmInclusao = "Cliente"
     !TpArquivo = 1
     .Update
     End With

     

     


    Saida:

     Close
     Set RS = Nothing
     Set RS1 = Nothing
     Set DB = Nothing
     MsgBox "Importação Concluida com Sucesso", vbInformation + vbOKOnly, "Sucesso"
     Exit Sub

    TrataErro:
     CdErro = Err.Number
     DsErro = Err.Description


     If CInt(CdErro) = 3022 Then ' Compilação condicional - Em desenvolvimento
     MsgBox "Arquivo ja foi Carregado !!! Verifique o Historico" & Err.Number, vbExclamation + vbOKOnly, "Erro: " & CStr(Err.Number)
     MsgBox "Remover Posições do Arquivo com Erro!!!", vbExclamation + vbOKOnly, "Erro"
     DoCmd.RunSQL "Delete * from TabelaPosicao where arquivo = '" & NomeArqCarregado & "';"
     MsgBox "1 Erro foi adicionado ao LOG do istema!!!", vbExclamation + vbOKOnly, "Erro"
     DoCmd.RunSQL "Delete * from ArquivosCarregados where NomeDoArquivo = '" & NomeArqCarregado & "';"
     MsgBox "Importação Não Concluida", vbExclamation + vbOKOnly, "Erro"
     With RS2
     .AddNew
     !cd_erro = CdErro
     !ds_erro = DsErro
     !nm_inclusao = "Cliente"
     !ds_info = "Arquivo ja carregado, erro de conflito de indice!!! arquivo = " & NomeArqCarregado
     .Update
     End With
     Close
     Set RS = Nothing
     Set RS1 = Nothing
     Set RS2 = Nothing
     Set DB = Nothing
     Exit Sub
     Else
     MsgBox Err.Description, vbExclamation + vbOKOnly, "Erro: " & CStr(Err.Number)
     MsgBox "Remover Posições do Arquivo com Erro!!!", vbExclamation + vbOKOnly, "Erro"
     DoCmd.RunSQL "Delete * from TabelaPosicao where arquivo = '" & NomeArqCarregado & "';"
     MsgBox "1 Erro foi adicionado ao LOG do sistema!!!", vbExclamation + vbOKOnly, "Erro"
     DoCmd.RunSQL "Delete * from ArquivosCarregados where NomeDoArquivo = '" & NomeArqCarregado & "';"
     MsgBox "Importação Não Concluida", vbExclamation + vbOKOnly, "Erro"
     With RS2
     .AddNew
     !cd_erro = CdErro
     !ds_erro = DsErro
     !nm_inclusao = "Cliente"
     !ds_info = "Erro não controlado, Erro ao importar o arquivo = " & NomeArqCarregado
     .Update
     End With
     Close
     Set RS = Nothing
     Set RS1 = Nothing
     Set RS2 = Nothing
     Set DB = Nothing
      MsgBox "Entrar em contato com a Responsavel", vbInformation + vbOKOnly, "Informação"
     Exit Sub
     End If
     Resume Saida

     

    End Sub

     

    att.

     

    kainsht

    terça-feira, 19 de abril de 2011 18:30

Todas as Respostas

  • Opa ninguem ...

     

    fiz um teste usando o serviço de importação do access, quando importo o txt como padrão europeu/ocidental, os registros continuam com os erros de caracteres onde tem acentuação.

     

    mas quando eu usei o padrão UTF-8, os dados vieram da forma correta. portanto o problema é o padrão no executor da rotina.

     

    existe alguma forma de eu setar o padrão que eu quero usar ou pelo menos converter os dados???

     

    abrs

     

    kainsht

    quarta-feira, 20 de abril de 2011 13:11