Hello Friends,
Requesting your help with VBA code to loop through a directory (simple folder holding a group of .txt files) to perform the below function on each .txt file. I was able to get the code to perform the function (shown below), but no idea how to create the code which will open each .txt file and have the contents copied and formatted onto an excel sheet from a directory. There may be 30+ files, hence, the loop is welcome. Thank you so much!
FUNCTION TO BE PERFORMED--
Sub CopyFromNotePad()
'Copy .txt file into Excel
Dim wbI As Workbook, wbO As Workbook
Dim wsI As Worksheet
Set wbI = Workbooks.Open("INSERT EXCEL FILE PATH")
Set wsI = wbI.Sheets("Sheet2")
Set wbO = Workbooks.Open("INSERT.TXT FILE PATH")
wbO.Sheets(1).Cells.Copy wsI.Cells
wbO.Close SaveChanges:=False
Columns("A:A").Select
Selection.TexttoColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, _
Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1)), _
TrailingMinusNumbers:=True
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub
I have used something like the below a few times, it is formatted for my test textfiles and copies to the sheet 2 of the Macro workbook - you can then save this sheet separately as a next step.
I am not sure of your data but one issue with the below in its current state is it will copy everything including headings - this might be good or bad depending on what you are doing, but fairly easy to get rid with either resize or filter and delete
Sub CopyFromNotePad()
'Copy .txt file into Excel
Dim twb As String
Dim wbI As Workbook, wbO As Workbook
Dim TextFileLocation As String
Dim TextFile As String
Dim LastRow As Long
twb = ThisWorkbook.Name
TextFileLocation = "FULL ADDRESS OF FOLDER WITH TEXT FILES IN IT"
'TextFile = Dir(TextFileLocation & "*.txt")
TextFile = Dir(TextFileLocation)
Do While Len(TextFile) > 0
LastRow = Workbooks(twb).Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Workbooks.OpenText (TextFileLocation & TextFile), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Tab:=True, Other:=True, _
OtherChar:="^", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1)), TrailingMinusNumbers:=True
Debug.Print Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("A1").CurrentRegion.Copy Workbooks(twb).Worksheets("Sheet2").Range("a" & LastRow)
Workbooks(TextFile).Close False
TextFile = Dir
Loop
End Sub
Hello Purfleet,
Thanks so much for your response. I tried running this but the macro did not produce a result, though it did not require debugging. It is possible I either failed to enter a file path or entered one were I shouldn't. Can you provide a complete mock example along with fictional file paths and names?
R S said
Hello Purfleet,
Thanks so much for your response. I tried running this but the macro did not produce a result, though it did not require debugging. It is possible I either failed to enter a file path or entered one were I shouldn't. Can you provide a complete mock example along with fictional file paths and names?
It won't error if it cant find the folder it will just exit, you could put a counter in the loop to tell you how many files were imported
Did you put the full file path in here?
TextFileLocation = "FULL ADDRESS OF FOLDER WITH TEXT FILES IN IT"
To avoid going in to the code i have changed the macro slightly so that the file path is typed into cell B1 on sheet 1 and if not present will display a message and exit.
Attached is the workbook
It is also a good idea to step through the code together with the Debugging blog that Phil mentioned then you can work out what it is doing.
