Inquiridor
Problemas de Caracteres especiais no Access

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 StringIf 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 importadoPosicao2 = InStr(1, Me.txtNomeArq, ".txt")
Posicao1 = Posicao2 - 16NomeArqCarregado = 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 textoPosicao1 = 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 WithWend
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 SubTrataErro:
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 SaidaEnd 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