This code intends to loop through a folder with multiple .txt files, then write a string from the file name into column 1 and a string from within the text file itself (it is in a fixed position) into column 2 using the Line Input function.
It returns the correct list in column 1, but column 2 is getting the value from the first file in each cell rather than the unique value from each file.
The objfile obviously advances, since the first column is getting a new value each time. And the
Line Input obviously accepts the file as called since it retrieves the value from the first fine/
Why does it not also advance for the Line Input section?
Sub ImportFileNames()
'Declarations
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim TextLine As String
Dim text As String
'Clears out old data
ActiveSheet.Columns(1).ClearContents
ActiveSheet.Columns(2).ClearContents
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Users\bbnewman\Desktop\Order Entry\EDIOrders")
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
If (objFile.DateCreated < Date - 183) Or (Right(objFile.Name, 3) <> "txt") Then
i = i + 1 'Skips noncompliant files
Else
'print body #
Cells(i + 1, 1) = Left(objFile.Name, 7)
'print PO#
Open objFile For Input As #1
Do While Not EOF(1)
Line Input #1, TextLine
text = text & TextLine
Loop
Cells(i + 1, 2).Value = Mid(text, 121, 9)
Close #1
i = i + 1
End If
Next objFile
'Deletes blank lines
Columns("A").SpecialCells(xlBlanks).EntireRow.Delete
End Sub
You write text = text & TextLine , that means text will keep it's content and the new Textline is added at it's end. With other words, text gets longer and longer, but the beginning never changes.
All you have to do is to reset text for every file: Put a statement text = "" before you start reading the file.
Open objFile For Input As #1
text = ""
Do While Not EOF(1)
Line Input #1, TextLine
text = text & TextLine
Loop
Related
I need to fetch string from text file into excel sheet.
I am able to fetch only first occurrence of the string ans paste in excel(A1).
Now i need to continue fetching till EOF and paste that string in A2,A3,A4....
Example:
A Text file contains a xxx=100 key value multiple times in text file.
xxx is constant while value is changes every time .
so i need to fetch all xxx value from text file and
paste it in each individual excel cell.
My code:
Private Sub CommandButton1_Click()
Dim myFile As String, text As String, textline As String, posLat As Integer, posLong As Integer
myFile = "C:\test\test.log"
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
posLat = InStr(text, "Response Code")
Range("A1").Value = Mid(text, posLat + 15, 3)
End Sub
Try with this improved code:
Private Sub CommandButton1_Click()
Dim myFile As String, text As String, textline As String, posLat As Integer, posLong As Integer
Dim I as long
myFile = "C:\test\test.log"
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
'text = text & textline
text = textLine
posLat = InStr(text, "Response Code")
Range("A1").Offset(I,0).Value = Mid(text, posLat + 15, 3)
I= I+1
Loop
Close #1
End Sub
try this:
Option Explicit
Sub main()
Dim myFile As String
Dim valsArray As Variant
Dim text As String, vals As String
Dim iVal As Long
myFile = "C:\test\test.log"
Open myFile For Input As #1
text = Input$(LOF(1), #1) '<--| read all file in a string
Close #1
valsArray = Split(text, "Response Code=") '<--| split text file into bits separated by "Response Code=" string
For iVal = 1 To UBound(valsArray) '<--| loop through generated array skipping its first element
vals = vals & Left(valsArray(iVal), 3) & "," '<--| build values string delimited by a comma
Next iVal
valsArray = Split(Left(vals, Len(vals) - 1), ",") '<--| split values string into an array
Range("A1").Resize(UBound(valsArray) + 1).Value = Application.Transpose(valsArray) '<--| write down the array
End Sub
I found this code by #Scott Holtzman and I need to tweek it a bit to match my needs. This code takes each line in a text file and puts it into seperate columns in an excel sheet(A1, B1, C1 and so on), each text file is stored in a seperate row(1,2,3 and so on). First i want it to only put text into the excel sheet if the line starts with a specific text, second i want it to only copy some of the text from each line into the excel sheet.
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder, file As file, FileText As TextStream
Dim TextLine As String, Items() As String
Dim i As Long, cl As Range
' Get a FileSystem object
Set fso = New FileSystemObject
' get the directory you want
Set folder = fso.GetFolder("D:\YourDirectory\")
Dim x As Long
x = 1 'to offset rows for each file
' Loop thru all files in the folder
For Each file In folder.Files
' set the starting point to write the data to
Set cl = ActiveSheet.Cells(x, 1)
' Open the file
Set FileText = file.OpenAsTextStream(ForReading)
Dim j As Long
j = 0 'to offset columsn for each line
' Read the file one line at a time
Do While Not FileText.AtEndOfStream
TextLine = FileText.ReadLine 'read line
cl.Offset(, j).Value = TextLine 'fill cell
j = j + 1
Loop
' Clean up
FileText.Close
x = x + 1
Next file
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
Here is what my text files look like:
From:NameName 'want all text except the "FROM:"
Date:yyyy.mm.dd 'want all text except the "Date:"
Type: XXXXXXXXX ' I don't want this line into excel
To: namename ' I don't want this line into excel
----------------------------- xxxxxxx ---------------------
A1: Tnr xxxxxxxxxxxxx 'want all text except the "A1: Tnr" only next 13char
A2: texttext 'want all text except the "A2:"
An: 'A1 and up to A14
A14: texttext 'want all text except the "A14:"
------------------------------ xxxxxx ----------------------
So in total there is 22 lines in the text file.
And if it is possible to use the FROM:, DATE:, A1: to A14: as headers in the first row that would be epic.
have tried to google my way to it, and tried a bit with this:
TextLine = FileText.ReadLine 'read line
If InStr(TextLine, "A1:")
but that works only for one line and i cant seem to get it to work with several lines. In addition it puts the output in cell F1, instead of A1. think this is since each line in text document gets one cell - even if nothing is written to it.
Here is a solution that fills one row in the Excel sheet per file, starting at row 2. You should manually fill in the titles in that first row as follows:
From | Date | A1 | A2 | ... | A14
The lines that you are not interested in are skipped, and the values are put in the correct columns:
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder, file As file, FileText As TextStream
Dim TextLine As String
Dim cl As Range
Dim num As Long ' numerical part of key, as in "Ann:"
Dim col As Long ' target column in Excel sheet
Dim key As String ' Part before ":"
Dim value As String ' Part after ":"
' Get a FileSystem object
Set fso = New FileSystemObject
' Get the directory you want
Set folder = fso.GetFolder("D:\YourDirectory\")
' Set the starting point to write the data to
' Don't write in first row where titles are
Set cl = ActiveSheet.Cells(2, 1)
' Loop thru all files in the folder
For Each file In folder.Files
' Open the file
Set FileText = file.OpenAsTextStream(ForReading)
' Read the file one line at a time
Do While Not FileText.AtEndOfStream
TextLine = FileText.ReadLine 'read line
key = Split(TextLine & ":", ":")(0)
value = Trim(Mid(TextLine, Len(key)+2))
num = Val(Mid(key,2))
If num Then key = Replace(key, num, "") ' Remove number from key
col = 0
If key = "From" Then col = 1
If key = "Date" Then col = 2
If key = "A" Then col = 2 + num
If col Then
cl.Offset(, col-1).Value = value ' Fill cell
End If
Loop
' Clean up
FileText.Close
' Next row
Set cl = cl.Offset(1)
Next file
End Sub
The above code will work well even if items are missing in your file, like if the line with "A12:" would not be present, this will leave the corresponding cell in the sheet empty, instead of putting the value of "A13:" there, causing a shift.
Even if the order of the lines would change, and "From:" would appear after "Date:", this will not have a negative effect in the output. "From" values will always get into the first column, "Date" values in the second, etc.
Also, if your file would contain many other lines with differing formats, they will all be ignored.
Replace the "Do While's" body with the following lines
TextLine = FileText.ReadLine 'read line
If Not (Left(TextLine, 1) = "T" Or Left(TextLine, 1) = "-") Then
TextLine = Trim(Mid(TextLine, InStr(TextLine, ":") + 1))
If (TextLine <> "") Then
cl.Offset(, j).Value = TextLine 'fill cell
j = j + 1
End If
End If
I am using VBA to import data from .txt files into a table of my spreadsheet which I am using for further pivot charts. The network directory that I am importing the files from contains ~5500 files and will grow over time at about 2000 files per year currently. The entries in the table are sorted by date (oldest to newest).
I have a macro which checks the date of the most recent entry, then uses DIR to search the network location and iterate through the files in that directory. For each file, if the file is newer than the most recent entry, I want to import the data and add it to the table. If the file is older, I want DIR to move to the next file. Below is the code I am currently using.
Sub NewFilesFromNetwork()
Dim myDatabase As Worksheet
Set myDatabase = Sheets("Database")
Dim TotalRows As Long, LastDate As Date
TotalRows = myDatabase.ListObjects("Table1").Range.Rows.Count
LastDate = Cells(TotalRows + 48, 6).Value 'the "+48" here is important because there are 48 hidden rows at the top of the spreadsheet before the table starts
Dim MyFolder As String, MyFile As String
On Error Resume Next
Application.ScreenUpdating = False
MyFolder = "*path to my network location*"
MyFile = Dir(MyFolder & "*.txt")
Dim t As Integer, k As Integer
t = 0 'counter for calculating total files imported
k = 0 'counter for calculating total files checked
Do While MyFile <> ""
TxtFile = MyFolder & MyFile
If FileDateTime(TxtFile) > LastDate Then
Open TxtFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
Call CommonImportCode 'separate sub which picks out information from the .txt file string and adds it to the table as a new entry
k = k + 1
t = t + 1
MyFile = Dir()
End If
k = k + 1
MyFile = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Number of files searched = " & k & vbNewLine & "Number of files imported = " & t
End Sub
The issue I am having is this:
I can check the network location and see that there are 10 new files. However, the macro only imports 5 of them, and seems to be importing only every other file of the new files. Is there a reason the macro is skipping files when they meet the conditions of the IF statement?
k = k + 1
MyFile = Dir()
That code is duplicated. If your "If" just above is true, you are jumping one file. Your loop should be :
Do While MyFile <> ""
TxtFile = MyFolder & MyFile
If FileDateTime(TxtFile) > LastDate Then
Open TxtFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
Call CommonImportCode 'separate sub which picks out information from the .txt file string and adds it to the table as a new entry
t = t + 1
End If
k = k + 1
MyFile = Dir()
Loop
or something approaching.
I need to extract data from a set of text files inside a folder. I tried several times without success, I hope that someone can help me.
All the files I have to read are inside the folder C:/test. The data I need to extract from the text files is located after the key word Read BRT Luminance.
The data should be placed in an excel file, every data extracted from a single text file inside a different cell.
I tried with this macro, but it doesn't work:
Dim myFile As String, myFolder As String, text As String, textline As String, originatorName As String, entryDescription As String, amount As Long
Sub Button1_Click()
Dim fs, f, f1, fc
Dim cella
cella = A2
'Add column headers
Range("A1").Value = "Brightness"
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("C:\test")
Set fc = f.Files
For Each f1 In fc
If InStr(1, f1.Name, ".txt") Then
'Open file
Open f1 For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
'Close file
Close #1
ReadBRTLuminance = InStr(text, "Read BRT Luminance")
ActiveCell.Offset(cella, 1).Value = Mid(text, ReadBRTLuminance + 31, 9)
cella = cella + 1
End If
Next
End Sub
My macro to extract the data I need from a single file works fine:
Dim myFile As String, myFolder As String, text As String, textline As String, originatorName As String, entryDescription As String
Dim amount As Long
Sub Button1_Click()
'Add column headers
Range("A1").Value = "Brightness"
'Show open file dialog box
myFile = Application.GetOpenFilename()
'Open file
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
'Close file
Close #1
ReadBRTLuminance = InStr(text, "Read BRT Luminance")
Range("A2").Value = Mid(text, ReadBRTLuminance + 31, 9)
End Sub
You're not clearing the value of text between files, so that's why you always get the value from the first file...
I found a Macro that works great for importing data from text files in a specified directory.
I don’t have any real experience writing in VBA but was wondering if there is a way to take the code below and add the ability to put the name of the file the macro retrieved the data from into a column (like column A).
I am using this for searching 100+ logs for a specific data and having the ability to import all the data from those logs into excel makes it really easy. Now I just need a way to see which file the data came from. Thanks in advance, I look forward to learning something new.
Macro:
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
' Get a FileSystem object
Set fso = New FileSystemObject
' get the directory you want
Set folder = fso.GetFolder("My File Path")
' set the starting point to write the data to
Set cl = ActiveSheet.Cells(1, 1)
' Loop thru all files in the folder
For Each file In folder.Files
' Open the file
Set FileText = file.OpenAsTextStream(ForReading)
' Read the file one line at a time
Do While Not FileText.AtEndOfStream
TextLine = FileText.ReadLine
' Parse the line into | delimited pieces
Items = Split(TextLine, "|")
' Put data on one row in active sheet
For i = 0 To UBound(Items)
cl.Offset(0, i).Value = Items(i)
Next
' Move to next row
Set cl = cl.Offset(1, 0)
Loop
' Clean up
FileText.Close
Next file
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
cl.value = file.Name
' Put data on one row in active sheet
For i = 0 To UBound(Items)
cl.Offset(0, i+1).Value = Items(i)
Next