[Resolvido]Importação de varios arquivos (.txt) no access

Alguem me pode dizer como faço para importar vários ficheiros .txt com o código indicado abaixo
O codigo em baixo faz o import de um arquivo .txt, mas eu precisava de importar pelo menos 12 arquivos
Quem puder ajudar...

Private Sub Comando3_Click()

Dim Delimitador As String
Dim DB As Database
Dim fnum As Integer
Dim LinhaDoTexto, LinhaDoTextoTemp As String
Dim InstrucaoSQL As String
Dim Posicao As Integer
Dim QtdDeRegistros As Long
Dim ArquivoTexto As String
Dim strBanco As Databases
Dim strTabela As String

   
   
ArquivoTexto = "C:\Users\Ricardo\Desktop\Log Pintura\2014-04-01_VisuLog_S33_SM1.txt" 'caminho do arq de texto
strTabela = "Tabela1" 'nome da tabela no banco

Delimitador = ";" 'defina aqui qual o delimitador
                                
                       
fnum = FreeFile
On Error GoTo NoTextFile
Open ArquivoTexto For Input As fnum

On Error GoTo NoDatabase
Set DB = CurrentDb
On Error GoTo 0

Do While Not EOF(fnum)
Line Input #fnum, LinhaDoTexto
If Len(LinhaDoTexto) > 0 Then

LinhaDoTexto = Replace(LinhaDoTexto, """", "")
InstrucaoSQL = "INSERT INTO " & _
strTabela & " VALUES ("
Do While Len(LinhaDoTexto) > 0
Posicao = InStr(LinhaDoTexto, Delimitador)
If Posicao = 0 Then
InstrucaoSQL = InstrucaoSQL & _
"'" & Replace(LinhaDoTexto, """", "") & "', "
LinhaDoTexto = ""
Else
InstrucaoSQL = InstrucaoSQL & _
"'" & Left$(LinhaDoTexto, Posicao - 1) & _
"', "
LinhaDoTexto = Mid$(Replace(LinhaDoTexto, """", ""), Posicao + Len(Delimitador))
End If
Loop

InstrucaoSQL = Left$(InstrucaoSQL, Len(InstrucaoSQL) - 2) & ")"


On Error GoTo SQLError
DB.Execute InstrucaoSQL
On Error GoTo 0
QtdDeRegistros = QtdDeRegistros + 1
End If
Loop

Close fnum
DB.Close
MsgBox "Inseridas " & Format$(QtdDeRegistos) & " Linhas"
Exit Sub

NoTextFile:
MsgBox "Erro na abertura do Arquivo de Texto."
Exit Sub

NoDatabase:
MsgBox "Erro na abertura do Banco."
Close fnum
Exit Sub

SQLError:
MsgBox "Erro na execusão do SQL '" & _
InstrucaoSQL & "'"
Close fnum
DB.Close
Exit Sub

End Sub

Olá RFPS,
Primeiramente, caso ainda não tenha lido as regras do fórum, aconselho a fazê-lo. Lá vai verificar algo sobre títulos em caixa alta e o uso da expressão Urgente.
Quanto ao seu problema, tente dar uma procurada aqui no fórum. Jogue na busca TXT. Tem muita coisa aqui sobre isso.
Sucesso.

Eu sei que tenho de ler os arquivos, mas depois não os consigo importar.

Boa tarde Ricardo,

Você precisa fazer um loop pelo diretório.

Estou pré resumindo que seu código já funciona para um arquivo.

Inseri algumas linhas no seu código, teste ai

crie um botão para teste ou altere o código deste,

Inclua o código abaixo e modifique o diretório.

Código:



Dim Delimitador As String
Dim DB As Database
Dim fnum As Integer
Dim LinhaDoTexto, LinhaDoTextoTemp As String
Dim InstrucaoSQL As String
Dim Posicao As Integer
Dim QtdDeRegistros As Long
Dim ArquivoTexto As String
Dim strBanco As Databases
Dim strTabela As String
Dim DiretorioArquivo As String     'Variável do diretório

'Setando o diretório
DiretorioArquivo = "C:\Users\Ricardo\Desktop\Log Pintura\"

'comentei esta linha pois pego o diretório na linha anterior e complemento abaixo

'ArquivoTexto = "C:\Users\Ricardo\Desktop\Log Pintura\2014-04-01_VisuLog_S33_SM1.txt" 'caminho do arq de texto

'complementando o caminho inteiro do diretório com os arquivos txt

ArquivoTexto = Dir(DiretorioArquivo & "*.txt", vbArchive)

'iniciar o loop pelo diretorio

Do While Arquivo <> ""


strTabela = "Tabela1" 'nome da tabela no banco

Delimitador = ";" 'defina aqui qual o delimitador
                                
                      
fnum = FreeFile
On Error GoTo NoTextFile
Open ArquivoTexto For Input As fnum

On Error GoTo NoDatabase
Set DB = CurrentDb
On Error GoTo 0

Do While Not EOF(fnum)
Line Input #fnum, LinhaDoTexto
If Len(LinhaDoTexto) > 0 Then

LinhaDoTexto = Replace(LinhaDoTexto, """", "")
InstrucaoSQL = "INSERT INTO " & _
strTabela & " VALUES ("
Do While Len(LinhaDoTexto) > 0
Posicao = InStr(LinhaDoTexto, Delimitador)
If Posicao = 0 Then
InstrucaoSQL = InstrucaoSQL & _
"'" & Replace(LinhaDoTexto, """", "") & "', "
LinhaDoTexto = ""
Else
InstrucaoSQL = InstrucaoSQL & _
"'" & Left$(LinhaDoTexto, Posicao - 1) & _
"', "
LinhaDoTexto = Mid$(Replace(LinhaDoTexto, """", ""), Posicao + Len(Delimitador))
End If
Loop

InstrucaoSQL = Left$(InstrucaoSQL, Len(InstrucaoSQL) - 2) & ")"

On Error GoTo SQLError
DB.Execute InstrucaoSQL
On Error GoTo 0
QtdDeRegistros = QtdDeRegistros + 1
End If
Loop

Close fnum
DB.Close

'linha para trocar de arquivo dentro do diretorio a abrir novamente

ArquivoTexto = Dir

Loop

'Fim do Loop



MsgBox "Inseridas " & Format$(QtdDeRegistos) & " Linhas"
Exit Sub

NoTextFile:
MsgBox "Erro na abertura do Arquivo de Texto."
Exit Sub

NoDatabase:
MsgBox "Erro na abertura do Banco."
Close fnum
Exit Sub

SQLError:
MsgBox "Erro na execusão do SQL '" & _
InstrucaoSQL & "'"
Close fnum
DB.Close
Exit Sub


Boas chsestrem e obrigado pela sua resposta, executei o código com as novas alterações mas não consegui importar, apesar de não dar nenhum erro e no fim aparecer "Inseridas Linhas", consegue-me dizer porque não esta importando?

Olá eu não tinha testado, só fiz estas linhas no momento

segue abaixo as alterações:

Código:


Dim Delimitador As String
Dim DB As DAO.Database
Dim fnum As Integer
Dim LinhaDoTexto, LinhaDoTextoTemp As String
Dim InstrucaoSQL As String
Dim Posicao As Integer
Dim QtdDeRegistros As Long
Dim ArquivoTexto As String
Dim strBanco As DAO.Databases
Dim strTabela As String
Dim DiretorioArquivo As String     'Variável do diretório

'Setando o diretório
'DiretorioArquivo = "C:\TesteTxt\"

DiretorioArquivo = "C:\Users\Ricardo\Desktop\Log Pintura\"

'comentei esta linha pois pego o diretório na linha anterior e complemento abaixo

'ArquivoTexto = "C:\Users\Ricardo\Desktop\Log Pintura\2014-04-01_VisuLog_S33_SM1.txt" 'caminho do arq de texto

'complementando o caminho inteiro do diretório com os arquivos txt

ArquivoTexto = Dir(DiretorioArquivo & "*.TXT", vbArchive)

'iniciar o loop pelo diretorio

Do While ArquivoTexto <> ""   'Modificado....


strTabela = "tbteste" 'nome da tabela no banco

Delimitador = ";" 'defina aqui qual o delimitador
                                
                      
fnum = FreeFile
On Error GoTo NoTextFile
Open DiretorioArquivo & ArquivoTexto For Input As fnum   'Modificado....

On Error GoTo NoDatabase
Set DB = CurrentDb
On Error GoTo 0

Do While Not EOF(fnum)
Line Input #fnum, LinhaDoTexto
If Len(LinhaDoTexto) > 0 Then

LinhaDoTexto = Replace(LinhaDoTexto, """", "")
InstrucaoSQL = "INSERT INTO " & _
strTabela & " VALUES ("
Do While Len(LinhaDoTexto) > 0
Posicao = InStr(LinhaDoTexto, Delimitador)
If Posicao = 0 Then
InstrucaoSQL = InstrucaoSQL & _
"'" & Replace(LinhaDoTexto, """", "") & "', "
LinhaDoTexto = ""
Else
InstrucaoSQL = InstrucaoSQL & _
"'" & Left$(LinhaDoTexto, Posicao - 1) & _
"', "
LinhaDoTexto = Mid$(Replace(LinhaDoTexto, """", ""), Posicao + Len(Delimitador))
End If
Loop

InstrucaoSQL = Left$(InstrucaoSQL, Len(InstrucaoSQL) - 2) & ")"

On Error GoTo SQLError
DB.Execute InstrucaoSQL
On Error GoTo 0
QtdDeRegistros = QtdDeRegistros + 1
End If
Loop

Close fnum
DB.Close



'linha para trocar de arquivo dentro do diretorio

ArquivoTexto = Dir

Loop



'Fim do Loop

MsgBox "Inseridas " & Format$(QtdDeRegistos) & " Linhas"
Exit Sub

NoTextFile:
MsgBox "Erro na abertura do Arquivo de Texto."
Exit Sub

NoDatabase:
MsgBox "Erro na abertura do Banco."
Close fnum
Exit Sub

SQLError:
MsgBox "Erro na execusão do SQL '" & _
InstrucaoSQL & "'"
Close fnum
DB.Close
Exit Sub


O código funcionou, mas só importou um arquivo. Não estou conseguindo importar todos os arquivos.txt

Testei aqui e funcionou corretamente,

Quantos arquivos existem no diretório "C:\Users\Ricardo\Desktop\Log Pintura\" ?

Você tem que modificar a variável StrTabela também....

Sds,

Tem 24 arquivos.txt
Quando acaba importar o 1, aparece: erro na execução do Sql INSERT INTO tabela1 VALUES (",",",",",",",",",")'
Eu acho que é de ter linhas sem dados
Não sei como resolver isto.

Sem ver o arquivo fica dificil de responder.

O que você precisava fazer com o loop deu certo OK

Talvez um pequeno tratamento de erro resolva o seu problema

Se você postar um ou dois arquivos txt talvez poderemos ajudar.


Sds,

As linhas em branco estão quase no fim do primeiro arquivo.txt

Apaguei o primeiro arquivo, e consegui importar todos os ficheiros.
O problema que está a dar é das linhas em branco do primeiro arquivo, mas não estou a ver como resolver esse erro.

Olá,

Para isto bastava tratar o erro da linha vazia.

insira o código abaixo no seu botão de comando

Código:


Dim Delimitador As String
Dim DB As DAO.Database
Dim fnum As Integer
Dim LinhaDoTexto, LinhaDoTextoTemp As String
Dim InstrucaoSQL As String
Dim Posicao As Integer
Dim QtdDeRegistros As Long
Dim ArquivoTexto As String
Dim strBanco As DAO.Databases
Dim strTabela As String
Dim DiretorioArquivo As String    'Variável do diretório

'Setando o diretório
'DiretorioArquivo = "C:\TesteTxt\"

DiretorioArquivo = "C:\Users\Ricardo\Desktop\Log Pintura\"

'comentei esta linha pois pego o diretório na linha anterior e complemento abaixo

'ArquivoTexto = "C:\Users\Ricardo\Desktop\Log Pintura\2014-04-01_VisuLog_S33_SM1.txt" 'caminho do arq de texto

'complementando o caminho inteiro do diretório com os arquivos txt

ArquivoTexto = Dir(DiretorioArquivo & "*.txt", vbArchive)

'iniciar o loop pelo diretorio

Do While ArquivoTexto <> ""  'Modificado....

strTabela = "Tabela1" 'nome da tabela no banco

Delimitador = ";" 'defina aqui qual o delimitador
                               
                     
fnum = FreeFile
On Error GoTo NoTextFile
Open DiretorioArquivo & ArquivoTexto For Input As fnum  'Modificado....

On Error GoTo NoDatabase
Set DB = CurrentDb
On Error GoTo 0

Do While Not EOF(fnum)
Line Input #fnum, LinhaDoTexto

QtdDeRegistros = QtdDeRegistros + 1

'Verificar se a linha está vazia, e então ir para a próxima

If Right$(LinhaDoTexto, 1) = ";" Then

GoTo PulaLinha

End If

If Len(LinhaDoTexto) > 0 Then

LinhaDoTexto = Replace(LinhaDoTexto, """", "")
InstrucaoSQL = "INSERT INTO " & _
strTabela & " VALUES ("
Do While Len(LinhaDoTexto) > 0
Posicao = InStr(LinhaDoTexto, Delimitador)
If Posicao = 0 Then
InstrucaoSQL = InstrucaoSQL & _
"'" & Replace(LinhaDoTexto, """", "") & "', "
LinhaDoTexto = ""
Else
InstrucaoSQL = InstrucaoSQL & _
"'" & Left$(LinhaDoTexto, Posicao - 1) & _
"', "
LinhaDoTexto = Mid$(Replace(LinhaDoTexto, """", ""), Posicao + Len(Delimitador))
End If

Loop

InstrucaoSQL = Left$(InstrucaoSQL, Len(InstrucaoSQL) - 2) & ")"

On Error GoTo SQLError
DB.Execute InstrucaoSQL
On Error GoTo 0
QtdDeRegistros = QtdDeRegistros + 1
End If

'Pulando a linha Vazia

PulaLinha:

Loop

Close fnum
DB.Close

'linha para trocar de arquivo dentro do diretorio

ArquivoTexto = Dir

Loop

'Fim do Loop

MsgBox "Inseridas " & QtdDeRegistos & " Linhas"

Exit Sub

NoTextFile:
MsgBox "Erro na abertura do Arquivo de Texto."
Exit Sub

NoDatabase:
MsgBox "Erro na abertura do Banco."
Close fnum
Exit Sub

SQLError:
MsgBox "Erro na execusão do SQL '" & _
InstrucaoSQL & "'"
Close fnum
DB.Close
Exit Sub


Obrigado chsestrem pela sua ajuda, já está funcionando