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
Related
This continues on from a previous question I have asked actually. I am desperate to find a way to remove the trailing blank lines from text files when generated from an excel file to which I have been unsuccessful so far. I have found the below code just now and when I execute it, I can see that it has the basis for what I want (I think) but I don't have the skill to amend it so that ignores any line with data in it and just deletes the blank spaces. Can anyone help me amend this so that it can delete those pesky white spaces please?
Sub AltText()
Dim File As String
Dim VecFile() As String, Aux As String
Dim i As Long, j As Long
Dim SizeNewFile As Long
File = Application.GetOpenFilename
'Import file lines to array excluding first 3 lines and
'lines starting with "-"
Open File For Input As 1
i = 0
j = 0
Do Until EOF(1)
j = j + 1
Line Input #1, Aux
If j > 3 And InStr(1, Aux, "-") <> 1 Then
i = i + 1
ReDim Preserve VecFile(1 To i)
VecFile(i) = Aux
End If
Loop
Close #1
SizeNewFile = i
'Write array to file
Open File For Output As 1
For i = 1 To SizeNewFile
Print #1, VecFile(i)
Next i
Close #1
MsgBox "File alteration completed!"
End Sub
To remove lines that are blank, try the following code:
Sub AltText()
Dim inFile As String
Dim outFile As String
Dim data As String
inFile = Application.GetOpenFilename
Open inFile For Input As #1
outFile = inFile & ".alt"
Open outFile For Output As #2
Do Until EOF(1)
Line Input #1, data
If Trim(data) <> "" Then
Print #2, data
End If
Loop
Close #1
Close #2
Kill inFile
Name outFile As inFile
MsgBox "File alteration completed!"
End Sub
you need to look for blank spaces and carriage return characters, so after you read the line, check for content:
dim temp as string
temp = Replace (aux, chr(10), "")
temp = Replace (temp,chr(13),"")
temp = Rtrim(Ltrim(temp)) ' remove just blank stuff
now check for the length:
if j > 3 and Len(temp) <> 0 then
......
add the lines
so your code should look like this:
Sub AltText()
Dim File As String
Dim VecFile() As String, Aux As String
Dim i As Long, j As Long
Dim SizeNewFile As Long
File = Application.GetOpenFilename
'Import file lines to array excluding first 3 lines and
'lines starting with "-"
Open File For Input As 1
i = 0
j = 0
Do Until EOF(1)
j = j + 1
Line Input #1, Aux
'=====
dim temp as string
temp = Replace (aux, chr(10), "")
temp = Replace (temp,chr(13),"")
temp = Rtrim(Ltrim(temp)) ' remove just blank stuff
'======
If j > 3 And Len(temp) <> 0 Then
i = i + 1
ReDim Preserve VecFile(1 To i)
VecFile(i) = Aux
End If
Loop
Close #1
SizeNewFile = i
'Write array to file
Open File For Output As 1
For i = 1 To SizeNewFile
Print #1, VecFile(i)
Next i
Close #1
MsgBox "File alteration completed!"
End Sub
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
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 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 have an Excel VBA macro that outputs to a text file. There is always a blank row at the bottom of the text file and I am having trouble getting rid of it. Any useful suggestions would be greatly appreciated! Thanks
Sub testExport()
Dim fPath As String, exportTxt As String
fPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Sample_" & Format(Now(), "HHNNSS") & ".txt"
exportTxt = "Project: Sample Output" & vbCrLf
exportTxt = exportTxt & "Model Version: 1 "
Open fPath For Append As #1 'write the new file
Print #1, exportTxt
Close #1
End Sub
From the help on the Print # statement and ways to specify charpos after the data has been output:
charpos Specifies the insertion point for the next character. Use a
semicolon to position the insertion
point immediately after the last
character displayed. Use Tab(n) to
position the insertion point to an
absolute column number. Use Tab with
no argument to position the insertion
point at the beginning of the next
print zone. If charpos is omitted, the
next character is printed on the next
line.
Try the following instead:
Print #1, exportTxt;
What I did and worked was, after I created the txt file,
counted the lines with data I wanted to be copied, and then loop through it creating a new file using the Print #1, exportTxt; and also Print #1, "", except in the last row.
Open sOrgFile For Input As #1
Do While Not EOF(1)
iCounter = iCounter + 1
Line Input #1, sData
If sData = "" Then Exit Do
Loop
Close #1
Open sOrgFile For Input As #1
Open sDestFile For Output As #2
Do While Not EOF(1)
iCounter2 = iCounter2 + 1
Line Input #1, sData
If sData = "" Then Exit Do
Print #2, sData;
If iCounter2 <> iCounter Then Print #2, ""
sData = ""
Loop
Print #1, exportTxt;
it prints everything in one line. no line break at all.