How to fetch particular key value from text file into excel - vba

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

Related

File not advancing for Line Input in VBA

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

Paste text from text file into worksheet line by line

I have the following code for pasting text from a text file into my worksheet. Problem is it dumps it all on one line!
For example if the text file reads:
Opened by Joe Bloggs 24 Feb 2017 11:08:12
Closed by Joe Bloggs 24 Feb 2017 11:23:12
This will all be pasted into Range("A1") as:
Opened by Joe Bloggs 24 Feb 2017 11:08:12 Closed by Joe Bloggs 24 Feb 2017 11:23:12.
I would rather it was pasted line by line down column A, such that:
Range("A1").Value = Opened by Joe Bloggs 24 Feb 2017 11:08:12
Range("A2").Value = Closed by Joe Bloggs 24 Feb 2017 11:23:12
My Code
Private Sub CommandButton1_Click()
Dim myFile As String, text As String, textline As String, Delimiter As String
myFile = "J:\...\Group Jobslist V1.2. Log.Log"
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
Range("A1").Value = text
End Sub
You could simply print each line in the loop.
Private Sub CommandButton1_Click()
Dim myFile As String, textline As String
myFile = "J:\...\Group Jobslist V1.2. Log.Log"
Dim i As Long
Open myFile For Input As #1
Do Until EOF(1)
i = i + 1
Line Input #1, textline
Range("A" & i).Value = textline
Loop
Close #1
End Sub
You could also use the FileSystemObject instead of older code style.
Try the code below, you can save each row (from Text file) to an array element, and afterwards just loop through all array elements and print them in Column A (row by row).
Option Explicit
Private Sub CommandButton1_Click()
Dim myFile As String, text As String, textline() As Variant, Delimiter As String
Dim i As Long
myFile = "J:\...\Group Jobslist V1.2. Log.Log"
ReDim textline(1 To 1000) '<-- Init array to large size
i = 1
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline(i)
text = text & textline(i)
i = i + 1
Loop
Close #1
ReDim Preserve textline(1 To i - 1) '<-- resize array to number of lines
' loop through all array elements and print each one in column A (new row)
For i = 1 To UBound(textline)
Range("A" & i).Value = textline(i)
Next i
End Sub

Excel VBA Putting text from a file into a worksheet

What I want is: To have the data inside the notepad, copied into the worksheet (starting on range A1).
What I tried:
Sub Test()
Dim testfile, textline
testfile = Application.GetOpenFilename()
Open testfile For Input As #1
Do Until EOF(1)
Line Input #1, textline
Loop
Close #1
ActiveWorkbook.Sheets("Sheet1").Range("A1").Value = textline
End Sub
Result:
Any advise as to why I am doing wrong, that it won't grab all the text in the notepad, and just the first line? Thanks.
You are almost there :) . Just need to write every textline i separate row, cause now you are changing Range("A1").Value only.
Sub Test()
Dim testfile, textline
testfile = Application.GetOpenFilename()
Open testfile For Input As #1
i = 1
Do Until EOF(1)
Line Input #1, textline
ActiveWorkbook.Sheets("Sheet1").Range("A" & i).Value = textline
i = i + 1
Loop
Close #1
End Sub

Extract string from multiple files using vba

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...

using excel vba read and edit text file into excel sheet

i would like to extract data from text file into excel worksheet.
my text file format is not the same for each line.
so for each line read, the first data would go input into the 1st excel column, and the next data to go into the 2nd excel column(same row) which is 2 or more blank spaces away from the 1st data. This goes on until all the text file data in that line are input into different columns of the same row.
text file:
data1 (space) data2 (space,space,space) data3 (space,space) data4
excel:
column 1 | column 2 | column 3
data1 data2 | data3 | data4
i do not know how to identify the spaces in each line to be written to excel sheet, pls advise, below is my code:
Sub test()
Dim ReadData, myFile As String
myFile = Application.GetOpenFilename()
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, ReadData
Loop
End Sub
While David's Solution works fine, here is another way to go about it.
Like David's my solution assumes that each data piece is not broken. This solution also assumes that each new row (that has data) will be placed in the Sheet1 row after the prior row
You need to use the Split() function to separate the pieces of data into their respective Strings.
Then, only using the strings with actual characters (i.e. no spaces or blank lines), you Trim the strings to remove spaces before or after your data(s)
Once all this has occurred, you are left with desired elements in an array which you populate the columns with.
Sub test()
'variables
Dim ReadData, myFile As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim s As Variant
Dim stringTemp1() As String
Dim stringTemp2() As Variant
i = 1
'get fileName
myFile = Application.GetOpenFilename()
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, ReadData
'check to make sure line is not empty
If Not ReadData = "" Then
'split row into array of strings
stringTemp1 = Split(ReadData, " ")
'remove any string elements that are blank
j = 0
ReDim stringTemp2(j)
For Each s In stringTemp1
If Not IsSpace(s) Then
ReDim Preserve stringTemp2(j)
stringTemp2(j) = s
j = j + 1
End If
Next s
'remove excess spaces from each element when adding to cell
For k = 0 To UBound(stringTemp2)
Worksheets("Sheet1").Cells(i, k + 1).Value = Trim(stringTemp2(k))
Next k
i = i + 1
Erase stringTemp2
Erase stringTemp1
End If
Loop
Close #1
End Sub
This external function was to check if an element in stringTemp1 contained data or not
Function IsSpace(ByVal tempString As String) As Boolean
IsSpace = False
If tempString = "" Then
IsSpace = True
End If
End Function
Assuming that each element of "data" does not internally contain spaces (e.g., your data is non-breaking, such as "John" or 1234 but not like "John Smith", or "1234 Main Street") then this is what I would do.
Use the Split function to convert each line to an array. Then you can iterate the array in each column.
Sub test()
Dim ReadData As String
Dim myFile As String
Dim nextCol as Integer
myFile = Application.GetOpenFilename()
Open myFile For Input As #1
Do Until EOF(1)
nextcol = nextCol + 1
Line Input #1, ReadData
Call WriteLineToColumn(ReadData, nextCol)
Loop
End Sub
Now that will call a procedure like this which splits each line (ReadData) and puts it in to the column numbered nextCol:
Sub WriteLineToColumn(s As String, col as Integer)
'Converts the string of data to an array
'iterates the array and puts non-empty elements in to successive rows within Column(col)
Dim r as Long 'row counter
Dim dataElement as Variant
Dim i as Long
For i = lBound(Split(s, " ")) to UBound(Split(s, " "))
dataElement = Trim(Split(s)(i))
If Not dataelement = vbNullString Then
r = r + 1
Range(r, col).Value = dataElement
End If
Next
End Sub
NOTE ALSO that a declaration of Dim ReadData, myFile as String is declaring ReadData as type Variant. VBA does not support implied declarations like this. To properly, strongly type this variable, it needs to be: Dim ReadData as String, myFile as String.