Caros colegas, já busquei em viários fóruns de outros colegas mais não consegue resolver uma questão:
Tenho um botão de comando que importar arquivo de texto para minha tabela que o código esta funcionado perfeitamente a questão e que eu quero que no mesmo comando ele importe este mesmo arquivo para outra tabela com outro delimitador diferente. Segue abaixo como esta atualmente meu cod vba.
Private Sub Comando8_Click()
Dim F As Long, Linha As String
Dim db As Database, rs As Recordset
F = FreeFile
Open txttexto For Input As F 'abre o arquivo texto
Set db = DBEngine(0).OpenDatabase(txtbase) 'abre o banco de dados
On Error Resume Next 'se a tabela não existir escapa da mensagem de erro
db.Execute "Delete * from Header0"
db.Execute "Delete * from Header1" 'exclui a tabela se ela ja existir
On Error GoTo trata_erro 'ativa tratamento de erros
Set rs = db.OpenRecordset("Header0", dbOpenTable) 'abre a tabela para receber os dados
Do While Not EOF(F)
Line Input #F, Linha 'lê uma linha do arquivo texto
'extrai a informação do arquivo texto usando a função MID
CodBanco = Mid(Linha, 1, 3)
LoteServico = Mid(Linha, 4, 4)
CodRefistro = Mid(Linha, 8, 1)
Filler = Mid(Linha, 9, 9)
TipoInscricao = Mid(Linha, 18, 1)
NumInscricao = Mid(Linha, 19, 14)
CodConvBanco = Mid(Linha, 33, 6)
ParTransmissao = Mid(Linha, 39, 2)
AmbCliente = Mid(Linha, 41, 1)
AmbCaixa = Mid(Linha, 42, 1)
OriAplicativo = Mid(Linha, 43, 3)
NunVersao = Mid(Linha, 46, 4)
Filler02 = Mid(Linha, 50, 3)
AgeCCorrente = Mid(Linha, 53, 5)
DVAgencia = Mid(Linha, 58, 1)
NumConta = Mid(Linha, 59, 12)
DVConta = Mid(Linha, 71, 1)
DVAgenciaConta = Mid(Linha, 72, 1)
NomeEmpresa = Mid(Linha, 72, 30)
NomeBanco = Mid(Linha, 103, 30)
Filler03 = Mid(Linha, 133, 10)
CodRemRet = Mid(Linha, 143, 1)
DTGeracaoArquivo = Mid(Linha, 144, 8)
HoraGeracaoArquivo = Mid(Linha, 152, 6)
NSA = Mid(Linha, 158, 6)
VerLeiauteArquivo = Mid(Linha, 164, 3)
DensGeracao = Mid(Linha, 167, 5)
ResBanco = Mid(Linha, 172, 20)
ResEmpresa = Mid(Linha, 192, 20)
ExcluFEBRABAN = Mid(Linha, 212, 11)
IDCobranca = Mid(Linha, 223, 3)
ExclusVAN = Mid(Linha, 226, 3)
TipoServico = Mid(Linha, 229, 2)
Ocorrencia = Mid(Linha, 231, 10)
rs.AddNew 'inclui novo registro
rs(0) = CodBanco
rs(1) = LoteServico
rs(2) = CodRefistro
rs(3) = Filler
rs(4) = TipoInscricao
rs(5) = NumInscricao
rs(6) = CodConvBanco
rs(7) = ParTransmissao
rs(8) = AmbCliente
rs(9) = AmbCaixa
rs(10) = OriAplicativo
rs(11) = NunVersao
rs(12) = Filler02
rs(13) = AgeCCorrente
rs(14) = DVAgencia
rs(15) = NumConta
rs(16) = DVConta
rs(17) = DVAgenciaConta
rs(18) = NomeEmpresa
rs(19) = NomeBanco
rs(20) = Filler03
rs(21) = CodRemRet
rs(22) = DTGeracaoArquivo
rs(23) = HoraGeracaoArquivo
rs(24) = NSA
rs(25) = VerLeiauteArquivo
rs(26) = DensGeracao
rs(27) = ResBanco
rs(28) = ResEmpresa
rs(29) = ExcluFEBRABAN
rs(30) = IDCobranca
rs(31) = ExclusVAN
rs(32) = TipoServico
rs(33) = Ocorrencia
rs.Update 'grava o registro inserido
Loop
MsgBox "Arquivo texto importado com sucesso !! "
rs.Close
db.Close
Close #F
Exit Sub
trata_erro:
MsgBox Err.Description
End Sub
desde já agradeço a paciência dos caros colegas.
Lembrando que já tentei consultar o autor deste modelo, sem resultado
Tenho um botão de comando que importar arquivo de texto para minha tabela que o código esta funcionado perfeitamente a questão e que eu quero que no mesmo comando ele importe este mesmo arquivo para outra tabela com outro delimitador diferente. Segue abaixo como esta atualmente meu cod vba.
Private Sub Comando8_Click()
Dim F As Long, Linha As String
Dim db As Database, rs As Recordset
F = FreeFile
Open txttexto For Input As F 'abre o arquivo texto
Set db = DBEngine(0).OpenDatabase(txtbase) 'abre o banco de dados
On Error Resume Next 'se a tabela não existir escapa da mensagem de erro
db.Execute "Delete * from Header0"
db.Execute "Delete * from Header1" 'exclui a tabela se ela ja existir
On Error GoTo trata_erro 'ativa tratamento de erros
Set rs = db.OpenRecordset("Header0", dbOpenTable) 'abre a tabela para receber os dados
Do While Not EOF(F)
Line Input #F, Linha 'lê uma linha do arquivo texto
'extrai a informação do arquivo texto usando a função MID
CodBanco = Mid(Linha, 1, 3)
LoteServico = Mid(Linha, 4, 4)
CodRefistro = Mid(Linha, 8, 1)
Filler = Mid(Linha, 9, 9)
TipoInscricao = Mid(Linha, 18, 1)
NumInscricao = Mid(Linha, 19, 14)
CodConvBanco = Mid(Linha, 33, 6)
ParTransmissao = Mid(Linha, 39, 2)
AmbCliente = Mid(Linha, 41, 1)
AmbCaixa = Mid(Linha, 42, 1)
OriAplicativo = Mid(Linha, 43, 3)
NunVersao = Mid(Linha, 46, 4)
Filler02 = Mid(Linha, 50, 3)
AgeCCorrente = Mid(Linha, 53, 5)
DVAgencia = Mid(Linha, 58, 1)
NumConta = Mid(Linha, 59, 12)
DVConta = Mid(Linha, 71, 1)
DVAgenciaConta = Mid(Linha, 72, 1)
NomeEmpresa = Mid(Linha, 72, 30)
NomeBanco = Mid(Linha, 103, 30)
Filler03 = Mid(Linha, 133, 10)
CodRemRet = Mid(Linha, 143, 1)
DTGeracaoArquivo = Mid(Linha, 144, 8)
HoraGeracaoArquivo = Mid(Linha, 152, 6)
NSA = Mid(Linha, 158, 6)
VerLeiauteArquivo = Mid(Linha, 164, 3)
DensGeracao = Mid(Linha, 167, 5)
ResBanco = Mid(Linha, 172, 20)
ResEmpresa = Mid(Linha, 192, 20)
ExcluFEBRABAN = Mid(Linha, 212, 11)
IDCobranca = Mid(Linha, 223, 3)
ExclusVAN = Mid(Linha, 226, 3)
TipoServico = Mid(Linha, 229, 2)
Ocorrencia = Mid(Linha, 231, 10)
rs.AddNew 'inclui novo registro
rs(0) = CodBanco
rs(1) = LoteServico
rs(2) = CodRefistro
rs(3) = Filler
rs(4) = TipoInscricao
rs(5) = NumInscricao
rs(6) = CodConvBanco
rs(7) = ParTransmissao
rs(8) = AmbCliente
rs(9) = AmbCaixa
rs(10) = OriAplicativo
rs(11) = NunVersao
rs(12) = Filler02
rs(13) = AgeCCorrente
rs(14) = DVAgencia
rs(15) = NumConta
rs(16) = DVConta
rs(17) = DVAgenciaConta
rs(18) = NomeEmpresa
rs(19) = NomeBanco
rs(20) = Filler03
rs(21) = CodRemRet
rs(22) = DTGeracaoArquivo
rs(23) = HoraGeracaoArquivo
rs(24) = NSA
rs(25) = VerLeiauteArquivo
rs(26) = DensGeracao
rs(27) = ResBanco
rs(28) = ResEmpresa
rs(29) = ExcluFEBRABAN
rs(30) = IDCobranca
rs(31) = ExclusVAN
rs(32) = TipoServico
rs(33) = Ocorrencia
rs.Update 'grava o registro inserido
Loop
MsgBox "Arquivo texto importado com sucesso !! "
rs.Close
db.Close
Close #F
Exit Sub
trata_erro:
MsgBox Err.Description
End Sub
desde já agradeço a paciência dos caros colegas.
Lembrando que já tentei consultar o autor deste modelo, sem resultado