When I am reading a 600kb text file (HTML code) into a string variable, it is truncating pretty much half of the content. Here is the code I have... where am I going wrong?
Dim fso As New FileSystemObject
Dim f As File
Dim fsoStream As TextStream
Dim strLine As String
Set f = fso.GetFile("C:\Users\Neanderthal\Desktop\MyProj\GMATClubLog.txt")
Set fsoStream = f.OpenAsTextStream(ForReading)
' Read the file line by line, printing the results to the Form
Do While Not fsoStream.AtEndOfStream
strLine = fsoStream.ReadLine
Debug.Print strLine
Loop
Len(strLine)
fsoStream.Close
Set fsoStream = Nothing
Set f = Nothing
Set fso = Nothing
Basically why I want to read the whole content of the text file is because I want to extract a repeating set of data based on the search criteria . And this is the repeating code
<td class="topicsName" style="width:100%">
<a class="newestPostIcon" href="http:someURL.com"></a>
<a title="some text" href="http://I want to extract this link.html" ></a>
</td>
The easiest way to read in a whole file into a string is the following:
Dim intFile As Integer
Dim strFile As String
Dim strData As String
strFile = "c:\temp\file.txt"
intFile = FreeFile
Open strFile For Input As #intFile
strData = Input(LOF(intFile), #intFile)
Close #intFile
If you want you can then split the data into an array of lines as follows:
Dim strLine() As String
strLine = Split(strData, vbCrLf)
And then loop through the array (for example to print each line on the form):
Dim lngIndex As Long
For lngIndex = 0 To UBound(strLine)
Print strLine(lngIndex)
Next lngIndex
Related
Background
I need to open multiple csvs in multiple folders, and for this matter I use FreeFile as input: let's say there are over 1000 csvs (powerquery will not have use here, since I only need the last row of data of each csv and then analyze that). I have seen that expanding to 512 may temporarily fix it in a way, but I do not think that is the core cause, hence, not providing a long term solution.
Problem
Seems like even if I close the file, the memory is not properly cleared, hence I get an error 67 after some looping on files has been done.
Code
I created a function to retrieve the Last Line within my main sub code, I even attempted to loop until freefile is 1 again (I added some sleep as well), but no luck, at some point, grows at 2.
Function Return_VarInCSVLine(ByRef NumLineToReturnTo As Long, ByRef TxtFilePathCSV As String, Optional ByRef IsLastLine As Boolean) As Variant
If NumLineToReturnTo = 0 Then NumLineToReturnTo = 1
'NumLineToReturnTo has to be at least 1 even if LastLine is set to true so no error is arised from IIF
Dim NumFileInMemory As Long
Dim ArrVarTxtLines() As Variant
Dim CounterArrTxtLines As Long
Dim TxtInLine As String
NumFileInMemory = FreeFile: CounterArrTxtLines = 1
Open TxtFilePathCSV For Input As #NumFileInMemory: DoEvents
Do While Not EOF(NumFileInMemory)
Line Input #NumFileInMemory, TxtInLine
ReDim Preserve ArrVarTxtLines(1 To CounterArrTxtLines)
ArrVarTxtLines(CounterArrTxtLines) = TxtInLine
CounterArrTxtLines = CounterArrTxtLines + 1
Loop
LoopUntilClosed:
Close #NumFileInMemory: Sleep (10): DoEvents
NumFileInMemory = FreeFile
If NumFileInMemory > 1 Then GoTo LoopUntilClosed
Return_VarInCSVLine = IIf(IsLastLine = True, ArrVarTxtLines(UBound(ArrVarTxtLines)), ArrVarTxtLines(NumLineToReturnTo))
End Function
Question
How can I avoid this error in this scenario? Or what are my alternatives? I used to do workbooks.Open but that is slower than just using FreeFile and then Open for input
You could try to use the FileSystemObject on a Windows PC
Function fsoReadLine(fileName As String, lineNo As Long, Optional lastLine As Boolean) As String
Dim fso As Object
Dim textFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set textFile = fso.OpenTextFile(fileName, 1)
Dim vDat As Variant
' Read the whole file and split it by lines
vDat = Split(textFile.ReadAll, vbCrLf)
Dim totalLines As Long
totalLines = UBound(vDat) + 1 ' zero based array!
If lastLine Then
fsoReadLine = vDat(totalLines - 1)
Else
If lineNo <= totalLines Then
fsoReadLine = vDat(lineNo - 1)
End If
End If
textFile.Close
End Function
And if you only need the last line you could shorten the code to
Function fsoLastLine(fileName As String) As String
Dim fso As Object
Dim textFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set textFile = fso.OpenTextFile(fileName, 1)
Dim vDat As Variant
' Read the whole file and split it by lines
vDat = Split(textFile.ReadAll, vbCrLf)
fsoLastLine = vDat(UBound(vDat))
textFile.Close
End Function
I have loaded a csv file in memory. My csv file uses ";" as the field delimiter.
It seems vba default delimiter is "," because when I try to access certain row and column of the loaded csv file, vba advances through the elements with refrence to number of "," used.
example:
In the 10th row of my data there are five columns: aa 12,34 bb 5,678 (here "," is decimal separator)
in the csv file which the delimiter is ";" it looks like this:
aa;12,34;bb;5,678
so when I write
MyData(10,2)
I am expecting to get 12,34 but vba returns 34;bb;5 because it uses "," as field delimiter.
So my question:
How can I tell vba to search through the loaded csv file with respect to ";" as delimiter instead of ","?
Thanks.
Instead of trying to change the delimiter which excel uses to load a csv file it might be more straightforward to do that on your own
First you use a function to load the lines of a text file into a collection and then you access the wanted line in that collection and go to the wanted column.
Code for this
Option Explicit
Function txtfileinCol(filename As String) As Collection
' loads the content of a textfile line by line into a collection
Dim fileContent As Collection
Set fileContent = New Collection
Dim fileNo As Long
Dim txtLine As String
fileNo = FreeFile
Open filename For Input As #fileNo
Do Until EOF(fileNo)
Line Input #fileNo, txtLine
fileContent.Add txtLine
Loop
Close #fileNo
Set txtfileinCol = fileContent
End Function
Sub Testit()
Const DELIMITER = ";"
Dim filename As String
Dim col As Collection
Dim vdat As Variant
Dim colNo As Long
Dim rowNo As Long
filename = "C:\Temp\FILE.csv"
Set col = txtfileinCol(filename)
colNo = 2
rowNo = 10
vdat = col.Item(rowNo) 'here you get the line you want
vdat = Split(vdat, DELIMITER) ' now you split the line with the DELIMITER you define
Debug.Print vdat(colNo - 1) ' now you print the content of the column you want
End Sub
Update: For accessing the row and column you could also use a function. The code would look like that
Option Explicit
Function txtfileinCol(filename As String) As Collection
' loads the content of a textfile line by line into a collection
Dim fileContent As Collection
Set fileContent = New Collection
Dim fileNo As Long
Dim txtLine As String
fileNo = FreeFile
Open filename For Input As #fileNo
Do Until EOF(fileNo)
Line Input #fileNo, txtLine
fileContent.Add txtLine
Loop
Close #fileNo
Set txtfileinCol = fileContent
End Function
Function getColRow(fileLines As Collection, rowNo As Long, colNo As Long, Optional delimiter As String) As String
Dim vdat As Variant
On Error GoTo EH:
If Len(delimiter) = 0 Then
delimiter = ";"
End If
vdat = fileLines.Item(rowNo) 'here you get the line
vdat = Split(vdat, delimiter) 'now you split the line with the delimiter
getColRow = vdat(colNo - 1) 'now you retrieve the content of the column
Exit Function
EH:
getColRow = ""
End Function
Sub Testit()
Dim filename As String
Dim col As Collection
filename = "C:\Temp\FILE.csv"
Set col = txtfileinCol(filename)
Debug.Print getColRow(col, 10, 2, ";")
End Sub
I have a PDF file that I have created in Bluebeam. It has shapes, images and text boxes throughout it.
Using VBA in Excel, I want to replace all occurrences of a string. I've tried many different peoples suggestions from other pages which successfully replace the string however, when i open the file in bluebeam, many of the shapes will have shifted or disappeared. The files encoding is ANSI.
Any wisdom to replace occurrences without messing up the other contents of the file?
Here is the code ive been playing with (from here):
Sub Test()
Dim objFSO
Const ForReading = 1
Const ForWriting = 2
Dim objTS 'define a TextStream object
Dim strContents As String
Dim fileSpec As String
fileSpec = ThisWorkbook.path & "\Template.pdf"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTS = objFSO.OpenTextFile(fileSpec, ForReading, False)
strContents = objTS.ReadAll
strContents = replace(strContents, "PLACEHOLDER", "TOPDOG")
objTS.Close
Set objTS = objFSO.OpenTextFile(fileSpec, ForWriting)
objTS.Write strContents
objTS.Close
End Sub
Originally I have a list of name of text files in the column A (in excel), and I want to go through all files to open and count its rows. When I run the script below the counter result is '1'
When I open the text files with Notepad++ or Sublime Text I see the lines of the file in different rows. But when I open the files with Notepad I see whole text in one row. What is the problem in this case and how can I fix it. (The line divider is 'LF'.)
Sub counting()
Dim FilePath As String
Dim counter As Integer
Dim curLine As String
FilePath = "C:\Users\kornel.fekete\Desktop\test\Test.txt"
Open FilePath For Input As #1
Do While Not EOF(1)
counter = counter + 1
Line Input #1, curLine
Loop
Cells(1, 1).Value = counter
Close #1
End Sub
I have to do this counting with more than 100 text files.
You could use a textstream:
Sub counting()
Dim fso As New FileSystemObject
Dim ts As TextStream
Dim longtext As String
Dim lines As Variant
Set ts = fso.OpenTextFile("C:\Users\kornel.fekete\Desktop\test\Test.txt", ForReading, False)
longtext = ts.ReadAll
ts.Close
lines = Split(longtext, vbLf)
Cells(1, 1) = UBound(lines) - LBound(lines) + 1
End Sub
You need to set a reference to Microsoft Scripting Runtime.
Greetings, I'm hoping for help in figuring out how to store each row of a text file read into a VBA program as a string. I want to modify one of the strings and then put them all back together, but do not know how to read through a text file and store each row as a separate variable in an intelligent way. Thanks for any help you can provide!
If you don't want to add references, you could just go with straight vba code.
Take for instance the following file wordlist.txt:
realize
empty
theorize
line
socialize
here
analyze
The following code uses two methods to do as you described (one more common than the other):
Option Explicit
Sub main()
Dim sFileName As String
Dim sMergedLineArray() As String
Dim sTextToFind As String
Dim sReplacementText As String
Dim sOutputFile As String
Const MY_DELIMITER = "|"
sFileName = "C:\deleteme\wordlist.txt"
sMergedLineArray = ReadFileIntoArray(sFileName)
sTextToFind = "ze"
sReplacementText = "se"
'Loop through each value in the array and make a change if you need to
Dim x As Integer
For x = 0 To UBound(sMergedLineArray)
If InStr(1, sMergedLineArray(x), sTextToFind, vbTextCompare) > 0 Then
sMergedLineArray(x) = Replace(sMergedLineArray(x), sTextToFind, sReplacementText, 1, -1, vbTextCompare)
End If
Next x
sOutputFile = "C:\deleteme\UK_Version.txt"
If Not SpitFileOut(sOutputFile, sMergedLineArray) Then
MsgBox "It didn't work :("
End If
'OR...put it all together, make a mass change and split it back out (this seems unlikely, but throwing it in there anyway)
sTextToFind = "se"
sReplacementText = "ze"
Dim sBigString As String
Dim sNewArray As Variant
sBigString = Join(sMergedLineArray, MY_DELIMITER)
sBigString = Replace(sBigString, sTextToFind, sReplacementText, 1, -1, vbTextCompare)
sNewArray = Split(sBigString, MY_DELIMITER, -1, vbTextCompare)
sOutputFile = "C:\deleteme\American_Version.txt"
If Not SpitFileOut(sOutputFile, sNewArray) Then
MsgBox "It didn't work"
End If
MsgBox "Finished!"
End Sub
Function ReadFileIntoArray(sFileName As String) As String()
Dim sText As String
Dim sLocalArray() As String
Dim iFileNum As Integer
Dim iLineCount As Integer
iFileNum = FreeFile
Open sFileName For Input As #iFileNum
Do Until EOF(iFileNum)
Input #iFileNum, sText
ReDim Preserve sLocalArray(iLineCount)
sLocalArray(iLineCount) = sText
iLineCount = iLineCount + 1
Loop
Close #iFileNum
ReadFileIntoArray = sLocalArray
End Function
Function SpitFileOut(sFileName As String, sMyArray As Variant) As Boolean
Dim iFileNum As Integer
Dim iCounter As Integer
SpitFileOut = False
iFileNum = FreeFile
Open sFileName For Output As #iFileNum
For iCounter = 0 To UBound(sMyArray)
Print #iFileNum, sMyArray(iCounter)
Next
Close #iFileNum
SpitFileOut = True
End Function
If you run the main sub, you'll end up with two files:
UK_Version.txt: This is the result of the first method
American_Version.txt: This is the result of the second
There's lesson 1 of VBA, young Padawan; absorb it, learn and change your login name :P
Look into the FileSystemObject (ref: 1, 2, 3)
You have to go to <Tools/References> menu and include the Microsoft Scripting Runtime and create a global variable Global fso as New FileSystemObject. Now anywhere in your code do things like fso.OpenTextFile() which returns a TextStream. Each TextStream has methods loke ReadLine(), ReadAll(), SkipLine(), WriteLine(), etc ...
Here is a quick sample code.
Global fso as New FileSystemObject
Sub TEST()
Dim ts As TextStream
Set ts = fso.OpenTextFile("text_file.txt", ForReading, False)
Dim s As String
s = ts.ReadAll()
End Sub