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
