Ir ao conteúdo
  • Cadastre-se
ppeterk

Excel converter TXT para excel

Recommended Posts

Galera, tudo bem? 
Tenho esse código abaixo que inicialmente faz o que eu quero. Ele abre o arquivo TXT em excel. O erro está dando na hora de salvar o arquivo em XLSX. 

Não pedindo muito (rsrs), mas gostaria também de, após salvar esse TXT em XLSX o usuário, através de um botão,  importasse esse arquivo para o arquivo ativo escolhendo a sheet desejada. Obrigado

Sub Convert_Csv()

    Dim File_Names As Variant
    Dim File_count As Integer
    Dim Active_File_Name As String
    Dim Counter As Integer
    Dim File_Save_Name As Variant

    File_Names = Application.GetOpenFilename(, , , , True)
    File_count = UBound(File_Names)
    Counter = 1
    Do Until Counter > File_count
        Active_File_Name = File_Names(Counter)
        Workbooks.Open Filename:=Active_File_Name
        Active_File_Name = ActiveWorkbook.Name
        File_Save_Name = InStr(1, Active_File_Name, ".txt", 1)
        File_Save_Name = Mid(Active_File_Name, 1, File_Save_Name) & ".xlsx"
        ActiveWorkbook.Save
        ActiveWorkbook.SaveAs Filename:=File_Save_Name, FileFormat:=xlOpenXMLWorkbooklocal
        ActiveWindow.Close
        Counter = Counter + 1
    Loop

End Sub

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Consegui fazer da forma que me atende. Segue o código para caso alguém necessite:

 

Sub importar ()
    Dim File_Names As Variant
    Dim File_count As Integer
    Dim Active_File_Name As String
    Dim Counter As Integer
    Dim File_Save_Name As Variant

    File_Names = Application.GetOpenFilename(, , , , True)

    File_count = UBound(File_Names)
    
    Counter = 1
    Do Until Counter > File_count
        Active_File_Name = File_Names(Counter)
        Workbooks.Open Filename:=Active_File_Name
        Active_File_Name = ActiveWorkbook.Name
        File_Save_Name = InStr(1, Active_File_Name, ".txt", 1)
        File_Save_Name = Mid(Active_File_Name, 1, File_Save_Name) & ".xlsx"
        ActiveWorkbook.Save
   
        
        ActiveWorkbook.SaveAs Filename:= _
        File_Save_Name, FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
        
        
        ActiveWindow.Close
        Counter = Counter + 1
    Loop


' import excel file

Dim importFileName As Variant
Dim importWorkbook As Workbook
Dim importSheet As Worksheet
Dim importRange As Range
       
    ' show open file dialog
    importFileName = File_Save_Name
    
    ' if user pressed cancel buton: exit
    If importFileName = False Then Exit Sub
    
    Application.ScreenUpdating = False
    
         ' if user selected a excel file, open it
         Set importWorkbook = Application.Workbooks.Open(importFileName)
         Set importSheet = importWorkbook.Worksheets(1)

         ' copy from import sheet
         Set importRange = importSheet.Range( _
             importSheet.Range("A1"), _
             importSheet.Range("J" & importSheet.Rows.Count).End(xlUp) _
         )
         
         importRange.Copy
         
         ' paste into Data sheet
    Windows("MacroEventos.xlsm").Activate
    Sheets("13ADM").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
 
 importWorkbook.Close
 

End sub

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações 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

×