IMPORTACAO DE ARQUIVO TXT COMPARANDO DADOS

XXXANGELSXXX 18/11/2009 00:52:49
#328012
Amigos, estou finalmente quase acabando meu sistema de controle de clientes, vejam bem se podem me ajudar nesta, preciso importar um determinado arquivo texto delimitado por ponto e virgula para o banco de dados, faço isso normalmente com a funçao que nosso amigo MARCELO_TREZE me enviou, por sinal funciona perfeitamente, so que queria dar uma implementada na rotina, como por exemplo, o arquivo txt que recebo sempre é o mesmo layout, e todo mes chega para mim novos clientes nessa listagem ou clientes que ja estao cadastrados no banco de dados, so que ao importar eu tenho que entrar no cadastro e fazer algumas alteraçoes para que o sistema possa emitir os relatorios de acordo com as minhas necessidades, entao toda vez que importo hoje estou excluindo todos os dados da tabela de clientes e importando um novo arquivo por cima, portanto, se eu tiver modificado algum dado de algum cliente esse mesmo vai ser perdido, entao eu queria importar somente os novos clientes, ou seja, so os clientes que foram acrescidos nesse arquivo, preservando os dados da tabela que ja foi modificada, exemplo...

eu ja tenho no banco o cliente codigo 234433 cadastrado com os dados completos, entao o sistema nao pode importar esse cliente mais, tem que preservar os dados dele... entao se tenho no txt o seguinte..

234433 - esse nao importa de jeito nenhum
875387 - esse eu quero importar, pois nao existe na minha tabela,

hoje como excluo todos os dados ta tabela eu faço assim.

Sub ImportarArquivodeClientes()
If txtAnexo.Text = Empty Then
MsgBox [Ô]Selecione o Arquivo para Importação![Ô], vbCritical, [Ô]Checkup Service[Ô]
Call ProcurarArquivo
Exit Sub
Else
Bar.Visible = True
Dim Coluna() As String
Dim Verifica() As String
Dim F As Long, sLine As String
Dim db As Database, rs As Recordset
caminho = ReadINI([Ô]Geral[Ô], [Ô]Caminho[Ô], App.Path & [Ô]\Config.ini[Ô])
On Error GoTo trata_erro

F = FreeFile
Open txtAnexo.Text For Input As F
Set db = DBEngine(0).OpenDatabase(caminho)

On Error Resume Next



Set rs = db.OpenRecordset([Ô]CadClientes[Ô], dbOpenTable)
db.Execute ([Ô]Delete * from CadClientes[Ô])

Do While Not EOF(F)
Line Input #F, sLine
Coluna = Split(sLine, [Ô];[Ô])

rs.AddNew

Bar.Value = Bar.Value + 2

rs(0) = Coluna(0)
rs(1) = f_RemoveAcento(MMCase(Coluna(1)))
rs(2) = f_RemoveAcento(MMCase(Coluna(2)))

If Len(Coluna(3)) <= 11 Then
Coluna(3) = Format(Coluna(3), [Ô]@@@.@@@.@@@-@@[Ô])
rs(26) = [Ô]-1[Ô]
Else
Coluna(3) = Format(Coluna(3), [Ô]@@.@@@.@@@/@@@@-@@[Ô])
rs(27) = [Ô]-1[Ô]

End If

rs(3) = f_RemoveAcento(MMCase(Coluna(3)))
rs(4) = f_RemoveAcento(MMCase(Coluna(4)))
rs(5) = [Ô]([Ô] & Left(Coluna(5), 2) & [Ô])[Ô] & Mid(Coluna(5), 3, 4) & [Ô]-[Ô] & Right(Coluna(5), 4)
rs(6) = f_RemoveAcento(MMCase(Coluna(6)))
rs(7) = f_RemoveAcento(MMCase(Coluna(7)))
rs(8) = f_RemoveAcento(MMCase(Coluna(8)))
rs(9) = f_RemoveAcento(MMCase(Coluna(9)))
rs(10) = f_RemoveAcento(MMCase(Coluna(10)))
rs(11) = Left(Coluna(11), 5) & [Ô]-[Ô] & Mid(Coluna(11), 6, 8)
rs(12) = f_RemoveAcento(MMCase(Coluna(12)))
rs(13) = f_RemoveAcento(MMCase(Coluna(13)))
rs(14) = f_RemoveAcento(MMCase(Coluna(14)))
rs(15) = f_RemoveAcento(MMCase(Coluna(15)))
rs(16) = f_RemoveAcento(MMCase(Coluna(16)))
rs(17) = f_RemoveAcento(MMCase(Coluna(17)))
rs(18) = f_RemoveAcento(MMCase(Coluna(18)))


rs.Update

Loop

rs.Close
db.Close

Close #F

frmCadClientes.Data1.Refresh

MsgBox [Ô]Arquivo Importado com Sucesso !! [Ô], vbInformation, [Ô]Checkup Service[Ô]
Bar.Visible = False
Unload Me
Exit Sub
If Err.Number <> 0 Then
trata_erro:
MsgBox [Ô]Um Erro Inesperado Ocorreu, Descrição do Erro : > [Ô] & Err.Description
End If
End If
End Sub

Se puderem me ajudar agradeço muitooooo...
MARCELO.TREZE 18/11/2009 09:46:50
#328027
colega basta vc fazer um Do Loop comparando os dados do banco com o novo arquivo

seria algo assim

Sub ImportarArquivodeClientes()
If txtAnexo.Text = Empty Then
MsgBox [Ô]Selecione o Arquivo para Importação![Ô], vbCritical, [Ô]Checkup Service[Ô]
Call ProcurarArquivo
Exit Sub
Else
  Bar.Visible = True
Dim Coluna() As String
Dim Verifica() As String
Dim F As Long, sLine As String
Dim db As Database, rs As Recordset
caminho = ReadINI([Ô]Geral[Ô], [Ô]Caminho[Ô], App.Path & [Ô]\Config.ini[Ô])
On Error GoTo trata_erro

F = FreeFile
Open txtAnexo.Text For Input As F
Set db = DBEngine(0).OpenDatabase(caminho)

On Error Resume Next




  Set rs = db.OpenRecordset([Ô]CadClientes[Ô], dbOpenTable)

Do While Not EOF(F)
  Line Input #F, sLine
  Coluna = Split(sLine, [Ô];[Ô])


Dim Proc As Recordset
Set Proc = db.Execute([Ô]SELECT * FROM CadClientes WHERE codigo = [Ô] & Coluna(0))

If Not Proc.EOF then

  rs.AddNew

       Bar.Value = Bar.Value + 2
       
   rs(0) = Coluna(0)
   rs(1) = f_RemoveAcento(MMCase(Coluna(1)))
   rs(2) = f_RemoveAcento(MMCase(Coluna(2)))

If Len(Coluna(3)) <= 11 Then
    Coluna(3) = Format(Coluna(3), [Ô]@@@.@@@.@@@-@@[Ô])
    rs(26) = [Ô]-1[Ô]
Else
    Coluna(3) = Format(Coluna(3), [Ô]@@.@@@.@@@/@@@@-@@[Ô])
    rs(27) = [Ô]-1[Ô]
    
End If

   rs(3) = f_RemoveAcento(MMCase(Coluna(3)))
   rs(4) = f_RemoveAcento(MMCase(Coluna(4)))
   rs(5) = [Ô]([Ô] & Left(Coluna(5), 2) & [Ô])[Ô] & Mid(Coluna(5), 3, 4) & [Ô]-[Ô] & Right(Coluna(5), 4)
   rs(6) = f_RemoveAcento(MMCase(Coluna(6)))
   rs(7) = f_RemoveAcento(MMCase(Coluna(7)))
   rs(8) = f_RemoveAcento(MMCase(Coluna(8)))
   rs(9) = f_RemoveAcento(MMCase(Coluna(9)))
   rs(10) = f_RemoveAcento(MMCase(Coluna(10)))
   rs(11) = Left(Coluna(11), 5) & [Ô]-[Ô] & Mid(Coluna(11), 6, 8)
   rs(12) = f_RemoveAcento(MMCase(Coluna(12)))
   rs(13) = f_RemoveAcento(MMCase(Coluna(13)))
   rs(14) = f_RemoveAcento(MMCase(Coluna(14)))
   rs(15) = f_RemoveAcento(MMCase(Coluna(15)))
   rs(16) = f_RemoveAcento(MMCase(Coluna(16)))
   rs(17) = f_RemoveAcento(MMCase(Coluna(17)))
   rs(18) = f_RemoveAcento(MMCase(Coluna(18)))
   
  
  rs.Update
End If
Loop
Proc.Close
rs.Close
db.Close

Close #F

frmCadClientes.Data1.Refresh

MsgBox [Ô]Arquivo Importado com Sucesso !! [Ô], vbInformation, [Ô]Checkup Service[Ô]
Bar.Visible = False
Unload Me
Exit Sub
If Err.Number <> 0 Then
trata_erro:
MsgBox [Ô]Um Erro Inesperado Ocorreu, Descrição do Erro : > [Ô] & Err.Description
End If
End If
End Sub


com o código acima talvez vc consiga fazer o que deseja

apenas altere conforme o seu banco esta linha

Set Proc = db.Execute([Ô]SELECT * FROM CadClientes WHERE codigo = [Ô] & Coluna(0))

coloquei um campo de nome código comparando com a primeira coluna do text

altere conforme esta em seu banco
XXXANGELSXXX 18/11/2009 13:53:38
#328064
Citação:

MARCELO-TREZE escreveu:
colega basta vc fazer um Do Loop comparando os dados do banco com o novo arquivo

seria algo assim

Sub ImportarArquivodeClientes()
If txtAnexo.Text = Empty Then
MsgBox [Ô]Selecione o Arquivo para Importação![Ô], vbCritical, [Ô]Checkup Service[Ô]
Call ProcurarArquivo
Exit Sub
Else
  Bar.Visible = True
Dim Coluna() As String
Dim Verifica() As String
Dim F As Long, sLine As String
Dim db As Database, rs As Recordset
caminho = ReadINI([Ô]Geral[Ô], [Ô]Caminho[Ô], App.Path & [Ô]Config.ini[Ô])
On Error GoTo trata_erro

F = FreeFile
Open txtAnexo.Text For Input As F
Set db = DBEngine(0).OpenDatabase(caminho)

On Error Resume Next




  Set rs = db.OpenRecordset([Ô]CadClientes[Ô], dbOpenTable)

Do While Not EOF(F)
  Line Input #F, sLine
  Coluna = Split(sLine, [Ô];[Ô])


Dim Proc As Recordset
Set Proc = db.Execute([Ô]SELECT * FROM CadClientes WHERE codigo = [Ô] & Coluna(0))

If Not Proc.EOF then

  rs.AddNew

       Bar.Value = Bar.Value + 2
       
   rs(0) = Coluna(0)
   rs(1) = f_RemoveAcento(MMCase(Coluna(1)))
   rs(2) = f_RemoveAcento(MMCase(Coluna(2)))

If Len(Coluna(3)) <= 11 Then
    Coluna(3) = Format(Coluna(3), [Ô]@@@.@@@.@@@-@@[Ô])
    rs(26) = [Ô]-1[Ô]
Else
    Coluna(3) = Format(Coluna(3), [Ô]@@.@@@.@@@/@@@@-@@[Ô])
    rs(27) = [Ô]-1[Ô]
    
End If

   rs(3) = f_RemoveAcento(MMCase(Coluna(3)))
   rs(4) = f_RemoveAcento(MMCase(Coluna(4)))
   rs(5) = [Ô]([Ô] & Left(Coluna(5), 2) & [Ô])[Ô] & Mid(Coluna(5), 3, 4) & [Ô]-[Ô] & Right(Coluna(5), 4)
   rs(6) = f_RemoveAcento(MMCase(Coluna(6)))
   rs(7) = f_RemoveAcento(MMCase(Coluna(7)))
   rs(8) = f_RemoveAcento(MMCase(Coluna(8)))
   rs(9) = f_RemoveAcento(MMCase(Coluna(9)))
   rs(10) = f_RemoveAcento(MMCase(Coluna(10)))
   rs(11) = Left(Coluna(11), 5) & [Ô]-[Ô] & Mid(Coluna(11), 6, 8)
   rs(12) = f_RemoveAcento(MMCase(Coluna(12)))
   rs(13) = f_RemoveAcento(MMCase(Coluna(13)))
   rs(14) = f_RemoveAcento(MMCase(Coluna(14)))
   rs(15) = f_RemoveAcento(MMCase(Coluna(15)))
   rs(16) = f_RemoveAcento(MMCase(Coluna(16)))
   rs(17) = f_RemoveAcento(MMCase(Coluna(17)))
   rs(18) = f_RemoveAcento(MMCase(Coluna(18)))
   
  
  rs.Update
End If
Loop
Proc.Close
rs.Close
db.Close

Close #F

frmCadClientes.Data1.Refresh

MsgBox [Ô]Arquivo Importado com Sucesso !! [Ô], vbInformation, [Ô]Checkup Service[Ô]
Bar.Visible = False
Unload Me
Exit Sub
If Err.Number <> 0 Then
trata_erro:
MsgBox [Ô]Um Erro Inesperado Ocorreu, Descrição do Erro : > [Ô] & Err.Description
End If
End If
End Sub


com o código acima talvez vc consiga fazer o que deseja

apenas altere conforme o seu banco esta linha

Set Proc = db.Execute([Ô]SELECT * FROM CadClientes WHERE codigo = [Ô] & Coluna(0))

coloquei um campo de nome código comparando com a primeira coluna do text

altere conforme esta em seu banco

Amigo, ele nao comparou os codigos nao.. ele importou o arquivo novamente, ou seja, duplicou o cadastro, era para ter incluido apenas 6 novos clientes, e ele importou os 1.000 clientes de novo, a tabela era para ficar com 1.006 agora esta 2000 clientes.. entendeu? veja o que fiz no codigo.
Sub ImportarArquivodeClientes()
If txtAnexo.Text = Empty Then
MsgBox [Ô]Selecione o Arquivo para Importação![Ô], vbCritical, [Ô]Checkup Service[Ô]
Call ProcurarArquivo
Exit Sub
Else
Bar.Visible = True
Dim Coluna() As String
Dim Verifica() As String
Dim F As Long, sLine As String
Dim db As Database, rs As Recordset
caminho = ReadINI([Ô]Geral[Ô], [Ô]Caminho[Ô], App.Path & [Ô]\Config.ini[Ô])
On Error GoTo trata_erro

F = FreeFile
Open txtAnexo.Text For Input As F
Set db = DBEngine(0).OpenDatabase(caminho)

On Error Resume Next




Set rs = db.OpenRecordset([Ô]CadClientes[Ô], dbOpenTable)

Do While Not EOF(F)
Line Input #F, sLine
Coluna = Split(sLine, [Ô];[Ô])


[ô]Dim Proc As Recordset
Set Proc = db.OpenRecordset([Ô]CadClientes[Ô], dbOpenTable)
db.Execute ([Ô]SELECT * FROM CadClientes WHERE CliCodigo = [Ô] & Coluna(0))

If Not Proc.EOF Then

rs.AddNew

Bar.Value = Bar.Value + 2

rs(0) = Coluna(0)
rs(1) = f_RemoveAcento(MMCase(Coluna(1)))
rs(2) = f_RemoveAcento(MMCase(Coluna(2)))

If Len(Coluna(3)) <= 11 Then
Coluna(3) = Format(Coluna(3), [Ô]@@@.@@@.@@@-@@[Ô])
rs(26) = [Ô]-1[Ô]
Else
Coluna(3) = Format(Coluna(3), [Ô]@@.@@@.@@@/@@@@-@@[Ô])
rs(27) = [Ô]-1[Ô]

End If

rs(3) = f_RemoveAcento(MMCase(Coluna(3)))
rs(4) = f_RemoveAcento(MMCase(Coluna(4)))
rs(5) = [Ô]([Ô] & Left(Coluna(5), 2) & [Ô])[Ô] & Mid(Coluna(5), 3, 4) & [Ô]-[Ô] & Right(Coluna(5), 4)
rs(6) = f_RemoveAcento(MMCase(Coluna(6)))
rs(7) = f_RemoveAcento(MMCase(Coluna(7)))
rs(8) = f_RemoveAcento(MMCase(Coluna(8)))
rs(9) = f_RemoveAcento(MMCase(Coluna(9)))
rs(10) = f_RemoveAcento(MMCase(Coluna(10)))
rs(11) = Left(Coluna(11), 5) & [Ô]-[Ô] & Mid(Coluna(11), 6, 8)
rs(12) = f_RemoveAcento(MMCase(Coluna(12)))
rs(13) = f_RemoveAcento(MMCase(Coluna(13)))
rs(14) = f_RemoveAcento(MMCase(Coluna(14)))
rs(15) = f_RemoveAcento(MMCase(Coluna(15)))
rs(16) = f_RemoveAcento(MMCase(Coluna(16)))
rs(17) = f_RemoveAcento(MMCase(Coluna(17)))
rs(18) = f_RemoveAcento(MMCase(Coluna(18)))


rs.Update
End If
Loop
Proc.Close
rs.Close
db.Close

Close #F

frmCadClientes.Data1.Refresh

MsgBox [Ô]Arquivo Importado com Sucesso !! [Ô], vbInformation, [Ô]Checkup Service[Ô]
Bar.Visible = False
Unload Me
Exit Sub
If Err.Number <> 0 Then
trata_erro:
MsgBox [Ô]Um Erro Inesperado Ocorreu, Descrição do Erro : > [Ô] & Err.Description
End If
End If
End Sub
XXXANGELSXXX 19/11/2009 08:19:23
#328132
Alguem pode dar uma forcinha?
MARCELO.TREZE 19/11/2009 09:33:10
#328139
tente mudar apenas isto

de

If Not Proc.EOF Then

para

If Proc.EOF Then
XXXANGELSXXX 19/11/2009 13:23:55
#328161
Citação:

MARCELO-TREZE escreveu:
tente mudar apenas isto

de

If Not Proc.EOF Then

para

If Proc.EOF Then

Amigo, agora ele nao importa nada, eu limpei a tabela de clientes e importei , ele so importou uma linha em branco, ou seja, me parece que a última linha do arquivo.
MARCELO.TREZE 19/11/2009 13:30:54
#328162
pergunta coloqeui na query

...WHERE codigo = [Ô] & coluna(0)

pergunta existe o campo código você fez a alteração nesta parte
XXXANGELSXXX 19/11/2009 13:37:29
#328164
fiz sim.. vou postar o codigo de novo..

Sub ImportarArquivodeClientes()
If txtAnexo.Text = Empty Then
MsgBox [Ô]Selecione o Arquivo para Importação![Ô], vbCritical, [Ô]Checkup Service[Ô]
Call ProcurarArquivo
Exit Sub
Else
bar.Visible = True
Dim Coluna() As String
Dim Verifica() As String
Dim F As Long, sLine As String
Dim db As Database, rs As Recordset
caminho = ReadINI([Ô]Geral[Ô], [Ô]Caminho[Ô], App.Path & [Ô]\Config.ini[Ô])
On Error GoTo trata_erro

F = FreeFile
Open txtAnexo.Text For Input As F
Set db = DBEngine(0).OpenDatabase(caminho)

On Error Resume Next




Set rs = db.OpenRecordset([Ô]CadClientes[Ô], dbOpenTable)

Do While Not EOF(F)
Line Input #F, sLine
Coluna = Split(sLine, [Ô];[Ô])


Dim Proc As Recordset
Set Proc = db.OpenRecordset([Ô]CadClientes[Ô], dbOpenTable)
db.Execute ([Ô]SELECT * FROM CadClientes WHERE CliCodigo = [Ô] & Coluna(0))

If Not Proc.EOF Then

rs.AddNew

bar.Value = bar.Value + 2

rs(0) = Coluna(0)
rs(1) = f_RemoveAcento(MMCase(Coluna(1)))
rs(2) = f_RemoveAcento(MMCase(Coluna(2)))

If Len(Coluna(3)) <= 11 Then
Coluna(3) = Format(Coluna(3), [Ô]@@@.@@@.@@@-@@[Ô])
rs(26) = [Ô]-1[Ô]
Else
Coluna(3) = Format(Coluna(3), [Ô]@@.@@@.@@@/@@@@-@@[Ô])
rs(27) = [Ô]-1[Ô]

End If

rs(3) = f_RemoveAcento(MMCase(Coluna(3)))
rs(4) = f_RemoveAcento(MMCase(Coluna(4)))
rs(5) = [Ô]([Ô] & Left(Coluna(5), 2) & [Ô])[Ô] & Mid(Coluna(5), 3, 4) & [Ô]-[Ô] & Right(Coluna(5), 4)
rs(6) = f_RemoveAcento(MMCase(Coluna(6)))
rs(7) = f_RemoveAcento(MMCase(Coluna(7)))
rs(8) = f_RemoveAcento(MMCase(Coluna(8)))
rs(9) = f_RemoveAcento(MMCase(Coluna(9)))
rs(10) = f_RemoveAcento(MMCase(Coluna(10)))
rs(11) = Left(Coluna(11), 5) & [Ô]-[Ô] & Mid(Coluna(11), 6, 8)
rs(12) = f_RemoveAcento(MMCase(Coluna(12)))
rs(13) = f_RemoveAcento(MMCase(Coluna(13)))
rs(14) = f_RemoveAcento(MMCase(Coluna(14)))
rs(15) = f_RemoveAcento(MMCase(Coluna(15)))
rs(16) = f_RemoveAcento(MMCase(Coluna(16)))
rs(17) = f_RemoveAcento(MMCase(Coluna(17)))
rs(18) = f_RemoveAcento(MMCase(Coluna(18)))


rs.Update
End If
Loop
Proc.Close
rs.Close
db.Close

Close #F

frmCadClientes.Data1.Refresh

MsgBox [Ô]Arquivo Importado com Sucesso !! [Ô], vbInformation, [Ô]Checkup Service[Ô]
bar.Visible = False
Unload Me
Exit Sub
If Err.Number <> 0 Then
trata_erro:
MsgBox [Ô]Um Erro Inesperado Ocorreu, Descrição do Erro : > [Ô] & Err.Description
End If
End If
End Sub
XXXANGELSXXX 19/11/2009 13:41:49
#328165
Amigos, eu tirei os tratamentos de erro, on error resume next, e me apresentou um erro 3065 - Nao e possivel executar uma consulta seleção

Debuguei para ver a linha do erro e é essa :

db.Execute ([Ô]SELECT * FROM CadClientes WHERE CliCodigo = [Ô] & Coluna(0))
MARCELO.TREZE 19/11/2009 13:41:57
#328166
tenta assim

Dim Proc As Recordset
Set Proc = db.OpenRecordset([Ô]SELECT * FROM CadClientes WHERE CliCodigo = [Ô] & Coluna(0) & [Ô][Ô])
XXXANGELSXXX 19/11/2009 15:45:33
#328176
Citação:

MARCELO-TREZE escreveu:
tenta assim

Dim Proc As Recordset
Set Proc = db.OpenRecordset([Ô]SELECT * FROM CadClientes WHERE CliCodigo = [Ô] & Coluna(0) & [Ô][Ô])

continua nao importando ainda.. rs rs.. se eu enviasse o banco de dados e o arquivo txt colocando em arquivos.. sera que me ajudaria mais facil?
Página 1 de 2 [15 registro(s)]
Tópico encerrado , respostas não são mais permitidas
Voltar