Ir ao conteúdo

Posts recomendados

Postado

Pessoal,

Preciso criar uma macro para importar arquivos TXT para Excel. Comecei pelo código gerado pelo próprio excel quando mandamos gravar uma macro e gerou o código abaixo:

ChDir "E:\Tim\Macro TXT-Excel"
    Workbooks.OpenText Filename:="E:\Tim\Macro TXT-Excel\Extract BGNA05.txt", _
        Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
        Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True

A minha intenção é jogar esse código para um CommandButton e quando eu clicar ele me mostra um explorer onde eu possa selecionar meu arquivo TXT.

Para isso, eu usei a linha de código a seguir: 
Arquivo = Application.GetOpenFilename("Arquivos Texto(*.txt), *.txt")

O problema é que eu não estou conseguindo juntar os dois, alguém pode me ajudar?

Obrigado!

Postado

use assim:

Arquivo = Application.GetOpenFilename("Arquivos Texto(*.txt), *.txt")    Workbooks.OpenText Filename:=Arquivo, _        Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _        Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True

Creio que seja assim.

  • 1 ano depois...
Postado

use assim:

Arquivo = Application.GetOpenFilename("Arquivos Texto(*.txt), *.txt")    Workbooks.OpenText Filename:=Arquivo, _        Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _        Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True

Creio que seja assim.

 

Então.... usei esse comando, mas o problema é que ele abre o txt em um novo workbook do excel, e não no workbook ativo. Como fazer ele abrir na mesma planilha que estou mexendo?

 

Achei uns códigos na internet mas ele faz linha por linha... o txt que tenho tem umas 28000 linhas...

Postado

Veja se as alter. lhe atende, a macro abre o txt em um "workbook temp",

em seguida copia e cola para a sua planilha(aba) ativa.

 

Sub ImpTxtWorkbookAtivo()
    Dim Arquivo As Variant
    Dim TempWb As Workbook
    Dim DestinoSh As Worksheet: Set DestinoSh = ThisWorkbook.ActiveSheet

    Arquivo = Application.GetOpenFilename("Arquivos Texto(*.txt), *.txt")

    If Arquivo = False Then Exit Sub
    Application.ScreenUpdating = False

    Workbooks.OpenText Filename:=Arquivo, _
                       Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
                       xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
                       Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
                                                                                 Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Set TempWb = ActiveWorkbook

    TempWb.ActiveSheet.Columns("A:Z").Copy DestinoSh.Range("A1")
    TempWb.Close savechanges:=False
    Application.ScreenUpdating = True
End Sub

  • Curtir 1
Postado

Veja se as alter. lhe atende, a macro abre o txt em um "workbook temp",

em seguida copia e cola para a sua planilha(aba) ativa.

 

Sub ImpTxtWorkbookAtivo()

    Dim Arquivo As Variant

    Dim TempWb As Workbook

    Dim DestinoSh As Worksheet: Set DestinoSh = ThisWorkbook.ActiveSheet

    Arquivo = Application.GetOpenFilename("Arquivos Texto(*.txt), *.txt")

    If Arquivo = False Then Exit Sub

    Application.ScreenUpdating = False

    Workbooks.OpenText Filename:=Arquivo, _

                       Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _

                       xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _

                       Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _

                                                                                 Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True

    Set TempWb = ActiveWorkbook

    TempWb.ActiveSheet.Columns("A:Z").Copy DestinoSh.Range("A1")

    TempWb.Close savechanges:=False

    Application.ScreenUpdating = True

End Sub

 

Ótimo Cara!! funcionou perfeito!

 

Ainda consegui fazer várias personalizações.

  • Curtir 1
  • 1 ano depois...
Postado

Estou utilizando essa macro também porém gostaria que ela fizesse o processo na Plan2

Pois quando clico no botão o processo está sendo feito na Plan1, alguém pode me ajudar com isso ?

 

Sub Abrir()
    Dim Arquivo As Variant
    Dim TempWb As Workbook
    Dim DestinoSh As Worksheet: Set DestinoSh = ThisWorkbook.ActiveSheet


    Arquivo = Application.GetOpenFilename("Arquivos Texto(*.txt), *.txt")

    If Arquivo = False Then Exit Sub
        Application.ScreenUpdating = False
        

    Workbooks.OpenText Filename:=Arquivo, _
        Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
        Array(Array(0, 1), Array(8, 1), Array(36, 1), Array(58, 1), Array(77, 1), Array(95, 1), _
        Array(104, 1), Array(120, 1)), TrailingMinusNumbers:=True
        
    
    Set TempWb = ActiveWorkbook
        TempWb.ActiveSheet.Columns("A:Z").Copy DestinoSh.Range("A1")
        TempWb.Close savechanges:=False
        Application.ScreenUpdating = True

End Sub

Visitante
Este tópico está impedido de receber novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

LANÇAMENTO!

eletronica2025-popup.jpg


CLIQUE AQUI E BAIXE AGORA MESMO!