I am trying to use vba to read all text in a text file and display it in an excel message box. the problem I have is whilst this is in effect working, it displays each line of text in a separate message box when instead I want it all in one?
can someone please show me where I am going wrong. thanks
If Range("L" & ActiveCell.Row).Value = "Performance" Then
Dim FilePath As String
Dim strLine As String
FilePath = "\\UKSH000-FILE06\Purchasing\New_Supplier_Set_Ups_&_Audits\ATTACHMENTS\" & Range("C" & ActiveCell.Row).Value & "\performance.txt"
Open FilePath For Input As #1
While EOF(1) = False
'read the next line of data in the text file
Line Input #1, strLine
'print the data in the current row
MsgBox strLine
'increment the row counter
i = i + 1
Wend
Close #1
End If
Within your loop you have to concatenate all the lines a string variable and output the result at the end. It's basically like this:
Dim Total As String
' ...
While EOF(1) = False
'read the next line of data in the text file
Line Input #1, strLine
Total = Total & vbNewLine & strLine
'increment the row counter
i = i + 1
Wend
MsgBox Total
Note: While this solution is working, for large files it may not be very efficient due to the fact that what looks like a concatenation in code, in fact means copying the existing content to a new memory location, and then inserting the new line's string. That is done for every line. So for 1000 lines, the incresingly large total string is copied around 999 times.
You need to accumulate the text in a separate string:
Write Dim strAll As String before the loop.
Replace the MsgBox in the loop with strAll = strAll & strLine.
After the loop, use MsgBox strAll
& is used to join strings in VBA. You could separate the individual lines with a space:
strAll = strAll & " " & strLine.
Or even multi-line
strAll = strAll & vbCrLf & strLine.
where vbCrLf is a VBA constant which means "carriage return followed by line feed". You'll introduce an extra space / line feed at the start of the string but I'll leave that for you to fix!
Related
I was able to get the higher rated answer (Alex K.) working to revise smaller files than the file I want to convert (1.7Gb) from here:
Loading linux text file into excel using VBA
I think using the Buffer has a memory limitation or I'm getting an error I wasn't expecting for large UNIX format files.
This problem has plagued me for sometime, and I usually just use Notepad++ and Edit→EOL conversion→Windows, but I'd like to be able to convert the file native to Excel so that my other, more complex, programs can work properly.
My files for those other programs aren't always UNIX carriage returns, but when they are, it throws a user error. Sometimes the user may not understand the work around (fix).
If the solution takes much much longer than Notepad++ or using unix2dos in linux then maybe I have to continue with those alternatives, but I'd really prefer a way to do this in EXCEL VBA.
Thanks in advance!
EDIT
: I'm adding the code I have, that works for files less than 1GB in size. Perhaps someone can fix it or poke holes at the approach (I think reading the whole file into memory throws an error and line by line doesn't seem possible that I know of). This code roughly takes 10 minutes for a test file I had which is just short of 1GB (14,581,137 lines):
Sub unix2Dos()
Dim FName As Variant
Dim myfilename As String
Dim FNum As Integer
Dim chars As Integer
Dim StartTime As Date, EndTime As Date
FNum = FreeFile
Dim FSO As Object
Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
Set fs2 = CreateObject("Scripting.FileSystemObject")
FName = Application.GetOpenFilename _
(filefilter:="All Files (*.*),*.*,Text Files(*.txt),*.txt,Bulk Files(*.bdf),*.bdf,Bulk Files(*.blk),*.blk,Bulk Files(*.bulk),*.bulk,Control Decks(*.dat),*.dat,")
If FName = False Then
MsgBox "You didn't select a file", vbCritical
Exit Sub
End If
On Error GoTo user_interupt
If FileExists(FName) Then
Set f = fs2.GetFile(FName)
filesize1 = f.Size / 1024 'in Kb
Else
filesize1 = 0
End If
If filesize1 >= 1048576 Then
MsgBox "File Size too large for this VBA to handle, please Convert to DOS another way. For Notepad++ go to Edit->EOL conversion->Windows." & Chr(13) & _
"Or Ultra Edit go to Advanced->Conversions->Unix/Mac (Legacy) to Dos" & Chr(13) & _
"Or in Linux, Cygwin, or Unix Environment from the comand line use this command:> unix2dos filename"
ElseIf filesize1 < 1048576 Then
StartTime = Timer
Open FName For Input As #1
'//load all
buff = Input$(LOF(1), #1)
Close #1
chars = Len(FName)
If Right(FName, 3) = "bdf" Then
myfilename = (Left(FName, chars - 4)) & "_DOS.bdf"
ElseIf Right(FName, 4) = "bulk" Then
myfilename = (Left(FName, chars - 5)) & "_DOS.bulk"
ElseIf Right(FName, 3) = "txt" Then
myfilename = (Left(FName, chars - 4)) & "_DOS.txt"
ElseIf Right(FName, 3) = "blk" Then
myfilename = (Left(FName, chars - 4)) & "_DOS.blk"
ElseIf Right(FName, 3) = "dat" Then
myfilename = (Left(FName, chars - 4)) & "_DOS.dat"
Else
myfilename = FName & "_DOS.txt"
End If
Open myfilename For Output Access Write As #FNum
'//Use Below; Testing showed very little distance in compute time
'buff = Replace$(buff, vbLf, vbCrLf)
' Print #FNum, buff
'//*or* line by line
Dim lines() As String: lines = Split(buff, vbLf)
For i = 0 To UBound(lines)
'MsgBox lines(i)
Print #FNum, lines(i)
Next
Close #FNum
EndTime = Timer
MsgBox "Unix2Dos: File Converted From UNIX to DOS " & Chr(13) & _
"If your file had a mix of Carriage returns (DOS AND UNIX), " & Chr(13) & _
"then you may have undesired blanks " & Chr(13) & _
" Run Time : " & Strings.Format(EndTime - StartTime, "0.0") & " sec"
End If
user_interupt:
If Err = 0 Then
'do nothing
Else:
MsgBox "The most recent error number is " & Err & _
". Its message text is: " & Error(Err)
End If
End Sub
Public Function FileExists(ByVal FileToTest As String) As Boolean
FileExists = (Dir(FileToTest) <> "")
End Function
From a very large Excel file, We loop and store the values from 3 of the columns into variables( uName(Row), mgrName(Row), title(Row) ). From this excel, we also get the number of rows.
The issue comes when I am trying to use StringBuilder to create a separate .xls file to be used later in the application. The code I have looks like this:
Dim XLstring As System.Text.StringBuilder = New System.Text.StringBuilder
Dim newfile As System.IO.StreamWriter
Dim fileTitle
XLstring.Append("Name,Manager,Title" & vbCrLf)
For X As Integer = 2 To countrows
If X = countrows Then
MsgBox(countrows)
MsgBox(uName(X) & "," & mgrName(X) & "," & title(X))
End If
XLstring.Append(uName(X) & "," & mgrName(X) & "," & title(X) & vbCrLf)
Next
fileTitle = System.DateTime.Now.ToString("yy-MM-dd hh-mm-ss") & ".xls"
filePath2 = "myPath" & fileTitle
newfile = File.CreateText(filePath2)
newfile.WriteLine(XLstring)
This works for the most part. I can see that I am grabbing the correct number of rows as well as the correct information in the last row using MsgBox. When I open the resulting .xls file however, there are entries missing at the end of the file. In addition, if I were to change
XLstring.Append("Name,Manager,Title" & vbCrLf)
to something like
XLstring.Append("Name,Manager" & vbCrLf)
the exact number of characters I removed from the Append line will now successfully appear at the end of the file where the information is missing.
Is there some weird functionality that I am not understanding using these functions? I am completey lost and don't understand this behavior.
You need to close the file when you're done:
newfile.Close()
On a side note, your file is being saved with the XLS extension, but since you are exporting a list of comma-separated values, I would suggest saving in CSV format instead.
I hope you can help with a VBA problem I'm trying to solve.
My situation:
I have multiple txt files as input for the search of a particular string ("tflux"). In every txt file the string is present so it is not possible that it is not found. I've written the code below, but I cannot find a way to tell excel that after copying the value that is related to the found string it has to move one cell lower for the next found value that is related to the next file it searches. Although I didn't try yet, I also would like excel to print the file name next to the numbers to be sure that the values correspond to a certain file name.
My VBA code so far:
Sub CommandButton1_Click()
Dim strF As String, strP As String, text As String, textline As String, tFlux As Integer
strP = "C:\test" 'change for the path of your folder
strF = Dir(strP & "\*.txt") 'Change as required
Do While strF <> vbNullString
Open strF For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
tFlux = InStr(text, "tflux")
Range("B2").Value = Mid(text, tFlux + 9, 3) <----- this is the line where I need help, Now the last found value is copied into cell B2, but I want excel to move to B3 after filling B2, move to B4 after filling B3, etc....
Loop
Close #1
text = ""
strF = Dir()
Loop
End Sub
The answer of VBA Pete will do the desired moving down for each found value. But I want to warn you about another, important problem in your code:
Line Input #1, textline
text = text & textline
tFlux = InStr(text, "tflux")
The above code has two problems. First, each time you read a line you append it to the previous text from the file, and you restart the search from the file's beginning. This is very slow, but moreover, it is wrong because if there are many occurrences of "tflux" in the file, you will always catch the first occurrence. Even if there is only one occurrence, you will catch it and report it many times each time you read a new line.
The second line of the above could should be rewritten this way:
text = textline ' <-- just copy the line, don't append it to previous lines from the file
How about a long variable that moves one value up in the range each time it runs through the loop:
Sub CommandButton1_Click()
Dim strF As String, strP As String, text As String, textline As String
Dim tFlux As Integer strP = "C:\test" 'change for the path of your folder
Dim x as long
strF = Dir(strP & "*.txt") 'Change as required
Do While strF <> vbNullString
x = 2
Open strF For Input As #1 Do Until EOF(1)
Line Input #1, textline
text = text & textline
tFlux = InStr(text, "tflux")
Range("B" & x).Value = Mid(text, tFlux + 9, 3)
x = x + 1
Loop
Close #1 text = "" strF = Dir() Loop
End Sub
I would recommend that you refactor your code as follows:
Sub CommandButton1_Click()
Dim strF As String, strP As String, textline As String, tFlux As Integer
Dim r As Long ' to keep track of which row we are writing to
strP = "C:\test" 'change for the path of your folder
strF = Dir(strP & "\*.txt") 'Change as required
r = 2 ' first line of output will go to row 2
Do While strF <> vbNullString
Open strF For Input As #1
Do Until EOF(1)
Line Input #1, textline
tFlux = InStr(textline, "tflux")
'See if we found "tflux"
If tFlux > 0 Then
'Found it - store the associated value
Cells(r, "B").Value = Mid(textline, tFlux + 9, 3)
'Store the filename too
Cells(r, "C").Value = strF
r = r + 1 ' set row pointer ready for next file
Exit Do ' found and processed - no need to keep looking within this file
End If
Loop
Close #1
strF = Dir()
Loop
End Sub
I included an Exit Do inside the "read file" loop so that, as soon as it finds the information you are looking for, it exits the loop. That saves time by not having to continue reading the rest of the file looking for something that you know won't be there.
I really hope i can get your help.
Ive been searching high and low for what is probably a simple solution.
We have hundreds of txt files that all relate to cnc programs. Unfortunately there has been a historical lack of control in keeping a strict numbering system for parts and operations.
I have to extract the 3rd and 4th line of txt from each file into an excel doc so we can remunerate some and catalogue all for referencing.
So far the closest thing i've found to what i'm after is in the thread
Extract a single line of data from numerous text files and import into Excel
however i cannot make it work - my excel knowledge is good but not with macros.
the start of every txt file is
#1 <blank line>
#2 %
#3 O00000 (part description)
#4 (part descriptio)
#5 rest of program.
.
.
.
as requested ive included the code i'm trying to modify.
Private Sub CommandButton1_Click()
Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, prog As String
MyFolder = "M:\CNC Programs\Haas lathe programs\Haas ST30 programs\Programs\Programs in .txt format"
MyFile = Dir(MyFolder & "*.txt")
Do While MyFile <> ""
Open (MyFolder & MyFile) For Input As #1
Do Until EOF(1)
Line Input #3, textline
text = text & textline
Loop
Close #1
MyFile = Dir()
Debug.Print text
nextrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheet1.Cells(nextrow, "A").Value = Mid(text, prog)
text = "" 'reset text
Loop
End Sub
Since you don't have much experience with vba, here are some points you might want to google and put the results together
Open a Text File in Excel VBA (you should start with that, and try to read one file)
Loop through all files in a certain folder with Excel VBA
Your code needs to do the following.
get a list of all the files you want to load
open each file of that list
read the 3rd and 4th line from that file
copy the lines to excel.
There are lots of examples on the internet, once you learn how to search
after a few hours and some help from a friend we came up with this, does more or less what i needed.
I know how I want to improve it, I just need to figure that out now. Again, I'm sure its a simple trick. Perseverance!!!
What I want to do with this now, if you can, is take my directory
'M:\CNC Programs\Haas Mills programs\All Mill Programs .txt format\'
and scan all subsequent folders for said .txt files and extract the same info into a workbook.
If I figure it out I'll update the post again.
Thanks for setting me on the right path Mister 832.
Private Sub CommandButton1_Click()
Dim MyMask As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String
Dim posCommentStart As String, posCommentFinish
Dim iLine As Integer
MyFolder = "M:\CNC Programs\Haas Mills programs\All Mill Programs .txt format\HAAS MINI-MILL BALLPADS & BALLPINS\"
MyMask = MyFolder & "*.txt"
MyFile = Dir(MyMask)
Do While MyFile <> ""
iLine = 0
Open (MyFolder & MyFile) For Input As #1
Do Until EOF(1) Or iLine >= 4
iLine = iLine + 1
Line Input #1, textline
If iLine >= 3 Then
text = text & textline 'second loop text is already stored -> see reset text
End If
Loop
Close #1
MyFile = Dir()
Debug.Print text
posCommentStart = InStr(text, "(")
posCommentFinish = InStr(text, ")")
If posCommentStart > 0 Then
nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
ActiveSheet.Cells(nextrow, "A").Value = Left(text, posCommentStart - 2)
ActiveSheet.Cells(nextrow, "B").Value = Mid(text, posCommentStart + 1, posCommentFinish - posCommentStart - 1)
End If
text = "" 'reset text
Loop
End Sub
I have data such as the following in a text file:
Member A
Diameter 60 in
Thickness 1 in
Yield Stress 50 ksi
Brace B
Diameter 54 in
Thickness 1 in
Yield Stress 50 ksi
I need to extract numerical diameter (or thickness, or yield stress) when a string of text "Member A" is found within a long text file. Data is always in same order.
I can extract data that is on the same line as the text I'm searching for using "Trim" / "Mid". I do not know how to refer to "the line below" the text I'm searching for.
My code:
Sub jtdtlextract()
Dim str, str1, strOutPut, strBrcAngle, strComnJt, strChrdDia As String
Dim FileToOpen, FileConverted, strRun, lngReturn, fs, f, s, ff
FileToOpen = Application.GetOpenFilename("All Files (*.*), *.*")
If FileToOpen <> False Then
MsgBox FileToOpen, 0, "Open File"
End If
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(FileToOpen)
FileConverted = UCase(f.ParentFolder.Path) & "\jt_dtls_extracted.txt"
Open FileToOpen For Input Access Read Shared As #1
Open FileConverted For Output Access Write Shared As #2
Do Until EOF(1)
Line Input #1, str
str1 = LTrim(str)
If Left(str1, 31) = "Detailed Review Report of Joint" Then
strComnJt = Trim(Mid(str1, 35, 4))
strOutPut = "Common_Jt" & Space(1) & strComnJt
Print #2, strOutPut
End If
'I have a lot more information to extract from the text file
'I was hoping to use a method similar to above since it's
'fairly simple and I have no coding experience, the code
'above only works when the information needed is on the
'same line as the information searched for. Was written
'by someone else.
Loop
Close #1
Close #2
strRun = "Notepad.exe " & FileConverted
lngReturn = Shell(strRun)
End Sub
You'll need some state-management code to keep track of where you are in the file.
If the file is not too big you don't need full-streaming and can use full-buffering in an array.
Then you can naturally scan this array using simple indexing :
name = lines(i)
diameter = parseDiameter(lines(i+1))
thickness = parseThickness(lines(i+2))
yieldStress = parseYieldStress(lines(i+3))
i = i + 5
Do Until EOF(1)
Line Input #1, str
str1 = LTrim(str)
If Left(str1, 31) = "Detailed Review Report of Joint" Then
strComnJt = Trim(Mid(str1, 35, 4))
strOutPut = "Common_Jt" & Space(1) & strComnJt
Print #2, strOutPut
Line Input #1, strDiscardThisLine
Line Input #1, str3rdLine
strOutPut = Trim(Mid(str3rdLine,35,4))
Print #2, strOutPut
End If