2

I have a folder with hundreds of text files that I need to parse some lines from. These lines then need to be pasted to an Excel sheet continuing down in order. This is my first attempt at VBA but I managed to pull the text I want from one file and paste it into the Excel sheet but I am stuck at being able to continuously run the macro through the entire folder and continuously add the parsed text lines to the Excel sheet. Sorry if this is rough but it is my first attempt at macro writing

I tried using Application.FileDialog(msoFileDialogFolderPicker) to call the folder that has all my text files in. I then opened the files I wanted with:

MyFile = Dir(MyFolder & "\", vbReadOnly)

I then tried a Do Loop to run the macro through each file but it didn't return any value despite completing the macro it just replaced the previously obtained results.

Here is the basic portion of my code:

Sub read() 'PURPOSE: Send All Data From Text File To A String Variable Dim TextFile As Integer Dim FilePath As String Dim FileContent As String Dim MyFolder As String, MyFile As String 'Opens a file dialog box for user to select a folder With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Show MyFolder = .SelectedItems(1) Err.Clear End With 'File Path of Text File MyFile = Dir(MyFolder & "\", vbReadOnly) 'Determine the next file number available for use by the FileOpen function TextFile = FreeFile 'Open the text file Open MyFile For Input As #1 'Store file content inside a variable Do Until EOF(1) Line Input #1, textline Text = Text & textline Loop Close #1 Dim objFSO As Object Dim objFolder As Object Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.getFolder(MyFolder) Dim fls As Object Dim i As Integer i = 1 For Each fls In objFolder.Files 'find required data from txt file starttime = InStr(Text, "+start=") endtime = InStr(Text, "+end=") so = InStr(Text, "+so=") engineer = InStr(Text, "+engineer=") account = InStr(Text, "+account=") incident = InStr(Text, "+number=") machine = InStr(Text, "+machine=") down = InStr(Text, "+down=") nextrow = Cells(Rows.Count, "A").End(xlUp).Row + 1 'label headers for txt data Range("A1").Value = " start time " Range("B1").Value = " end time " Range("C1").Value = " SO " Range("D1").Value = " Total Time " Range("E1").Value = " Engineer " Range("F1").Value = " Account" Range("G1").Value = " Incident" Range("H1").Value = " Machine" Range("I1").Value = " down" 'paste obtained txt data into excel cells Range("A2" & i).Value = Mid(Text, starttime + 7, 16) Range("B2").Value = Mid(Text, endtime + 5, 16) Range("C2").Value = Mid(Text, so + 4, 8) Range("E2").Value = Mid(Text, engineer + 10, 4) Range("F2").Value = Mid(Text, account + 9, 6) Range("G2").Value = Mid(Text, incident + 8, 4) Range("H2").Value = Mid(Text, machine + 9, 4) Range("I2").Value = Mid(Text, down + 6, 9) 'Report Out macro finished MsgBox " Finished " 'Close Text File Close TextFile i = i + 1 Next End Sub

This gives me the results I want but I have to go through each individual file which is time consuming. I would rather have it loop though the entire folder pulling the information from each file and adding the pulled text to the Excel sheet continuing down each row. Any help would be greatly appreciated.

Improve this question
0

1 Answer 1

Reset to default
2

You can loop through all the files of the folder by using the below code. Amend it according to your need.

'First you will need to declare an object Dim objFSO As Object Dim objFolder As Object 'then set this object to the address you received in first part of your code Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.getFolder(MyFolder) 'Now create a new object for files in that folder and apply the for loop as below Dim fls As Object Dim i As Integer i = 1 For Each fls In objFolder.Files '----- Your Code to perform on Each file Range("A" & i+1).value ' Change all accordingly i = i + 1 Next

This should do the Job!

Edit ----------- You will have to change all the fields 

Range("A" & i + 1).Value = Mid(Text, starttime + 7, 16) Range("B" & i + 1).Value = Mid(Text, endtime + 5, 16) Range("C" & i + 1).Value = Mid(Text, so + 4, 8) Range("E" & i + 1).Value = Mid(Text, engineer + 10, 4) Range("F" & i + 1).Value = Mid(Text, account + 9, 6) Range("G" & i + 1).Value = Mid(Text, incident + 8, 4) Range("H" & i + 1).Value = Mid(Text, machine + 9, 4) Range("I" & i + 1).Value = Mid(Text, down + 6, 9)

Edit for file opening:

You will have to open each file in the loop:

 MyFile = Dir(MyFolder & "\" fls.Name, vbReadOnly)

After that extract the text the way you are doing. But this have to be done in the Loop. So that the process is repeated for every file.

Improve this answer
Sign up to request clarification or add additional context in comments.

13 Comments

thanks for the input! ill try working with this
Comment if you face any error in this.
It is looping through each file now but it is not updating the excel sheet with the new values from each file. any recommendation? I suspect its because of my shotty attempt to assign a cell range for each value
Yes you will have to loop the values that your pasting. So in short you have to declare an integer i and in the same loop assign it a value 1 if you want to paste values in your excel from 1st row and change your code as "Range("A:" & i).value" . Also don't forget to add 1 to the value of i before "Next" so that in next iteration code will paste values in next row of excel.
I have amended the code. Hope it will solve your issue.
|

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.