Copy text files from text file to Worksheet With VBA

[Abhishekghorpade]

I have multiple text files saved in the Path “C:\Users\E5554593\Desktop\New folder”. I need to import the data from text files to excel. Each file data should come in separate tabs, Tab name will be same as text file name.
Can anyone help me out with this please.. Its consuming lot of time

 

[GR00007]

Here's a basic way to get files in a directory:

    MyPath = "C:\Users\E5554593\Desktop\New folder"
    MyExt = "*.xls"
    MyFile = Dir(MyPath & MyExt)
    Do While MyFile <> ""
        Workbooks.Open Filename:=MyPath & MyFile
        ....
        MyFile = Dir
    Loop

The above is getting an old .xls file, change that to .txt. If all the text files are the same format you can record opening one of them to get the open formatting needed and change the 'Open' above appropriately.

After opening each workbook you can use this to assign tab names:

    BookName = ActiveWorkbook.Name
    Windows(YourTargetWorkbook).Activate
    Sheets.Add After:=ActiveSheet
    vx = ActiveSheet.Name
    Sheets(vx).Name = BookName

 

[Abhishekghorpade]

I dont know how to use the codes.. Can you please make it complete single code

 

[GR00007]

Are you familiar enough with VBA to record opening one of your text files into a spreadsheet so that the data looks like you want?

 

[Abhishekghorpade]

I know how to record but the final report will be keep on changing... Only the importing data is constant

 

[Abhishekghorpade]

I use below code to import data from Word docs.. Its working perfectly fine.. but not working for text files...

Code:-
Sub GetDocContent()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim strFolder As String, strFile As String, lRow As Long
Dim WkSht As Worksheet: Set WkSht = ActiveSheet
strFolder = "C:\Users" & Environ("UserName") & "\Downloads"
strFile = Dir(strFolder & "*.doc", vbNormal)
While strFile <> ""
Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
lRow = WkSht.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
With wdDoc
.Range.Copy
WkSht.Paste WkSht.Range("A" & lRow)
.Close SaveChanges:=False
End With
strFile = Dir()
Wend
wdApp.Quit

 

[GR00007]

I know how to record but the final report will be keep on changing... Only the importing data is constant

Please record the importing of one of the text files and getting the columns the way you want them.

 

[Abhishekghorpade]

Here is the macro recorded code.. this is only for one file i have multiples files in the same folder. and i want each file data in the different tab

Sub importtextfile()
'
' importtextfile Macro
'
' Keyboard Shortcut: Ctrl+Shift+I
'
ActiveWorkbook.Queries.Add Name:="212130", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Table.FromColumns({Lines.FromBinary(File.Contents(""C:\Users\E5554593\Desktop\New folder\212130.txt""), null, null, 1252)})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " Source"
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=212130;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [212130]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "_212130"
.Refresh BackgroundQuery:=False
End With
Application.CommandBars("Queries and Connections").Visible = False
ActiveSheet.ListObjects("_212130").ShowAutoFilterDropDown = False
ActiveSheet.ListObjects("_212130").ShowTableStyleRowStripes = False
ActiveSheet.ListObjects("_212130").ShowHeaders = False
Selection.TextToColumns Destination:=Range("A2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(14, 1), Array(33, 1), Array(50, 1), Array(75, 1), _
Array(82, 1), Array(86, 1)), TrailingMinusNumbers:=True
Cells.Select
Range("A2").Activate
Selection.Columns.AutoFit
Range("F12").Select
ActiveWindow.SmallScroll Down:=0
End Sub

 

[GR00007]

Based on your TextToColumns I believe this mimics your file structure - fixed width with 7 columns.

Sub Macro1()
'   HouseKeeping
    MyPath = "%USERPROFILE%\Desktop\New Folder\"
    MyExt = "*.txt"
    ThisBook = ActiveWorkbook.Name
    MyFile = Dir(MyPath & MyExt)
    Do While MyFile <> ""
        Workbooks.OpenText Filename:=MyPath & MyFile, Origin:=437, _
            StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(14 _
            , 1), Array(33, 1), Array(50, 1), Array(75, 1), Array(82, 1), Array(86, 1)), _
            TrailingMinusNumbers:=True
        Cells.Select
        Selection.Columns.AutoFit
        vTabName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
        vLR = ActiveSheet.UsedRange.Rows.Count
        Range("A1:G" & vLR).Select
        Selection.Copy
        Windows(ThisBook).Activate
        Sheets.Add After:=ActiveSheet
        vx = ActiveSheet.Name
        Sheets(vx).Name = vTabName
        Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Windows(vTabName & ".txt").Activate
        Application.DisplayAlerts = False
        ActiveWindow.Close savechanges:=False
        Application.DisplayAlerts = True
        MyFile = Dir
    Loop
End Sub

 

[Abhishekghorpade]

its working for only one file.after the file is copied to excel error 400 is coming and other files are not getting copied to excel.