MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

3 participantes

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

    avatar
    RFPS
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 13
    Registrado : 22/04/2014

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

    Mensagem  RFPS 22/4/2014, 20:09

    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


    Última edição por RFPS em 24/4/2014, 17:50, editado 2 vez(es)
    rdrck
    rdrck
    VIP
    VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1012
    Registrado : 11/03/2014

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

    Mensagem  rdrck 23/4/2014, 16:22

    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.


    .................................................................................
    Meu Programa / OS:
    Access 2010 - Windows 10.
    avatar
    RFPS
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 13
    Registrado : 22/04/2014

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

    Mensagem  RFPS 23/4/2014, 18:22

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


    Última edição por RFPS em 3/6/2014, 15:30, editado 1 vez(es)
    chsestrem
    chsestrem
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 463
    Registrado : 01/03/2010

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

    Mensagem  chsestrem 23/4/2014, 18:46

    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


    .................................................................................
    Charles Sestrem
    http://www.vbabit.com.br
    avatar
    RFPS
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 13
    Registrado : 22/04/2014

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

    Mensagem  RFPS 23/4/2014, 19:36

    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?
    chsestrem
    chsestrem
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 463
    Registrado : 01/03/2010

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

    Mensagem  chsestrem 23/4/2014, 19:57

    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


    .................................................................................
    Charles Sestrem
    http://www.vbabit.com.br
    avatar
    RFPS
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 13
    Registrado : 22/04/2014

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

    Mensagem  RFPS 23/4/2014, 20:09

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


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 463
    Registrado : 01/03/2010

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

    Mensagem  chsestrem 23/4/2014, 20:19

    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,


    .................................................................................
    Charles Sestrem
    http://www.vbabit.com.br
    avatar
    RFPS
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 13
    Registrado : 22/04/2014

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

    Mensagem  RFPS 23/4/2014, 20:34

    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.
    chsestrem
    chsestrem
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 463
    Registrado : 01/03/2010

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

    Mensagem  chsestrem 23/4/2014, 20:39

    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,


    .................................................................................
    Charles Sestrem
    http://www.vbabit.com.br
    avatar
    RFPS
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 13
    Registrado : 22/04/2014

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

    Mensagem  RFPS 23/4/2014, 21:03

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


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 13
    Registrado : 22/04/2014

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

    Mensagem  RFPS 23/4/2014, 21:13

    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.
    chsestrem
    chsestrem
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 463
    Registrado : 01/03/2010

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

    Mensagem  chsestrem 24/4/2014, 15:35

    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


    .................................................................................
    Charles Sestrem
    http://www.vbabit.com.br
    avatar
    RFPS
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 13
    Registrado : 22/04/2014

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

    Mensagem  RFPS 24/4/2014, 17:49

    Obrigado chsestrem pela sua ajuda, já está funcionando Very Happy 

      Data/hora atual: 27/1/2023, 03:39