I am writing a makro to read thousands of big text files, analyse their content and save a desired part of its content into my Excel worksheet.
On another thread it said that the readAll method of a TextStream object is a good way to do so, so I copied a piece of code and built my makro around it.
Every few hundred textfiles though it throws a weird error. The file being processed is being emptied by my makro and the makro stops working.
Again: Before I start the makro the textfile that throws an error has content in it(as far as I can see it looks like any other textfile), but when Excel throws the error the textfile's content is deleted.
Can you think of the reason for this error or suggest an alternative that might now give this error?
Function readFileContent(FILENAME As String) As String
'reads the txt file into a string and deletes parts before the first "<TestFlow" Element`
Dim lngStart As Long
Dim lngLength As Long
Dim fsoMyFile As FileSystemObject
Dim tsTempo As TextStream
Dim StrContent As String
lngStart = 0
lngLength = 0
Set fsoMyFile = New FileSystemObject
Set tsTempo = fsoMyFile.OpenTextFile(FILENAME, ForReading)
StrContent = tsTempo.ReadAll
Set tsTempo = fsoMyFile.OpenTextFile(FILENAME, ForWriting, False, TristateFalse)
tsTempo.Write (StrContent)
'Cut of everything up to the first <TextFlow tag
lngStart = InStr(StrContent, "<TextFlow")
If lngStart = 0 Then
readFileContent = "SKIPPED"
End If
lngLength = Len(StrContent)
StrContent = Right(StrContent, lngLength - lngStart)
readFileContent = StrContent
End Function
The line StrContent = tsTempo.ReadAll is the line where the program stops. I get no error message.
As you use same file name for reading and writing, you should close it after each operation:
Set fsoMyFile = New FileSystemObject
Set tsTempo = fsoMyFile.OpenTextFile(FILENAME, ForReading)
StrContent = tsTempo.ReadAll
tsTempo.Close '// <=== CLOSE
Set tsTempo = fsoMyFile.OpenTextFile(FILENAME, ForWriting, False, TristateFalse)
tsTempo.Write (StrContent)
tsTempo.Close '// <=== CLOSE
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'm writing a script where I wish to write an HTML doc to a string from sharepoint.
Dim Content As String
Dim strShare As String: strShare = "\\link\to\share.html"
Dim iFile As Integer: iFile = FreeFile
Open strShare For Input As #iFile
Content = Input(LOF(iFile), iFile)
Close #iFile
However, I find I get a "path/file access error" every time I run the script for the first time upon boot. Once I visit "\link\to\share.html" in IE for the first time, the path begins to resolve in the VBA script.
My only thought is that IE is performing some sort of "DNS Cache" that VBA can't do. Currently my workaround is to catch the error and force the URL to open in IE the first time the script is run. After that, every other HTML file under that share loads fine.
As a test, I tried switching between from what I understand is http:// formatting (forward slash) and WebDAV formatting (\\ formating), and only the backslash separated paths ever work. I also tried to resolve the share to an IP and try it that way, but that never worked.
My last thought is to try mapping the share to a drive letter name and then specifically accessing the share with G:\link\to\mapped\share.html. But I don't see this as an elegant solution, and wonder if it will receive the same error any way.
Is there something blatant that I do not understand about WebDAV, Windows file handling, and VBA file inputs? There's something weird going on under the hood with resolving that shared domain, and I can't seem to debug it.
See if this helps here and an example below that I used.
2 things though: I only worked with Excel files on Sharepoint and I was already logged in there.
Dim oFSO As Object
'Dim oFolder As Object 'if needed
'Dim oFile As Object 'if needed
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("\\sharepoint.site.com#SSL\DavWWWRoot\sites\")
'For Each oFolder In oFolder.SubFolders 'loops through folders
' For Each oFile In oFolder.Files 'loops through files
' 'do stuff
' Next oFile
'Next oFolder
I'm a bit confused about what you want to do. Do you want to check out files from SP and check files back into SP?
Sub testing()
Dim docCheckOut As String
'docCheckOut = "//office.bt.com/sites/Training/Design Admin/Training Plan/adamsmacro.xlsm"
docCheckOut = "http://your_path_here/ExcelList.xlsb"
Call UseCheckOut(docCheckOut)
End Sub
Sub UseCheckOut(docCheckOut As String)
' Determine if workbook can be checked out.
If Workbooks.CanCheckOut(docCheckOut) = True Then
Workbooks.CheckOut docCheckOut
Else
MsgBox "Unable to check out this document at this time."
End If
End Sub
Or...do you want to list files in a SP folder?
Sub ListFiles()
Dim folder As Variant
Dim f As File
Dim fs As New FileSystemObject
Dim RowCtr As Integer
Dim FPath As String
Dim wb As Workbook
RowCtr = 1
FPath = "http://excel-pc:43231/Shared Documents"
For Each f In FPath
'Set folder = fs.GetFolder("C:\Users\Excel\Desktop\Ryan_Folder")
'For Each f In folder.Files
Cells(RowCtr, 1).Value = f.Name
RowCtr = RowCtr + 1
Next f
End Sub
Sub test()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Users\Excel\Desktop\Ryan_Folder")
'Set colSubfolders = objFolder.SubFolders
'For Each objSubfolder In colSubfolders
Cells(RowCtr, 1).Value = f.Name
RowCtr = RowCtr + 1
'Next
End Sub
I am trying to use FileSystemObject methods to find a specific line in a text file, and within that line replace a specific string. I am relatively new to this, as my current code has excel open the text file and replace what I need it to replace then save and close it. This way is no longer an option, as having excel open the text file takes too long and holds up the file.
This is how far I have gotten so far.
-
Sub FindLines()
Const ForReading = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFSO = FSO.OpenTextFile("C:\Users\Carella Home\Desktop\boomboom.txt", ForReading, False)
Do Until objFSO.AtEndOfStream = True
go = objFSO.ReadLine
If InStr(1, go, "ant", vbTextCompare) > 0 Then
bo = Replace(go, "t", "wow")
End If
Loop
objFSO.Close
Set objFSO = FSO.OpenTextFile("C:\Users\Carella Home\Desktop\boomboom.txt", 2)
End Sub
-
The best I can do is open the file up to write, but I have no idea how to find the line and replace it with the line that I need to replace it with.
Please let me know if, in the event that you are willing to help/guide me in the correct direction, you need more information. I have searched a lot and have seen people suggest other ways of doing this. I need to learn how to edit lines this way. Can someone please help me?
Thanks in advance!
-Anthony C.
Not sure if this is the most efficient method but one idea would be to use the CreateTextFile method of the FileSystemObject, to create another file you can write to.
I've tested this on a small file and appears to be working as expected.
Modified after answer accepted to avoid .ReadLine and .WriteLine loops
Sub FindLines()
'Declare ALL of your variables :)
Const ForReading = 1 '
Const fileToRead As String = "C:\Users\david_zemens\Desktop\test.txt" ' the path of the file to read
Const fileToWrite As String = "C:\Users\david_zemens\Desktop\test_NEW.txt" ' the path of a new file
Dim FSO As Object
Dim readFile As Object 'the file you will READ
Dim writeFile As Object 'the file you will CREATE
Dim repLine As Variant 'the array of lines you will WRITE
Dim ln As Variant
Dim l As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set readFile = FSO.OpenTextFile(fileToRead, ForReading, False)
Set writeFile = FSO.CreateTextFile(fileToWrite, True, False)
'# Read entire file into an array & close it
repLine = Split(readFile.ReadAll, vbNewLine)
readFile.Close
'# iterate the array and do the replacement line by line
For Each ln In repLine
ln = IIf(InStr(1, ln, "ant", vbTextCompare) > 0, Replace(ln, "t", "wow"), ln)
repLine(l) = ln
l = l + 1
Next
'# Write to the array items to the file
writeFile.Write Join(repLine, vbNewLine)
writeFile.Close
'# clean up
Set readFile = Nothing
Set writeFile = Nothing
Set FSO = Nothing
End Sub
Then, depending on whether you want to get rid of the "original" file you could do something like:
'# clean up
Set readFile = Nothing
Set writeFile = Nothing
'# Get rid of the "old" file and replace/rename it with only the new one
Kill fileToRead
Name fileToWrite As fileToRead
End Sub
Here is a much faster and shorter method as compared to the FileSystemObject
Sub Sample()
Dim MyData As String, strData() As String
'~~> Read the file in one go!
Open "C:\Users\Carella Home\Desktop\boomboom.txt" For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
End Sub
All your text file data is now in the array strData Simply loop though the array and find the text that you want to replace and write it back to the SAME file.
I want to delete the last line contain '*' of two notepad and apend the reamining data into a new notepad by excel macro.
Please guys help me out. I can't find any suggestion.
Using #mehow's suggestion, here is some code that you can use:
' To get this to run, you'll need to reference Microsoft Scripting Runtime:
' Per http://stackoverflow.com/questions/3233203/how-do-i-use-filesystemobject-in-vba
' Within Excel you need to set a reference to the VB script run-time library. The relevant file is usually located at \Windows\System32\scrrun.dll
' To reference this file, load the Visual Basic Editor (ALT-F11)
' Select Tools - References from the drop-down menu
' A listbox of available references will be displayed
' Tick the check-box next to 'Microsoft Scripting Runtime'
' The full name and path of the scrrun.dll file will be displayed below the listbox
' Click on the OK button
Sub appFiles()
'File path and names for each file
Dim sFile1 As String
Dim sFile2 As String
Dim sFileLast As String
'Search string
Dim sSearchStr As String
'Delimiter used to separate/join lines
Dim sDL As String
'If the final file already exists, should it overwrite the previous _
contents (True) or append to the end of the file (False)
Dim doOverwrite As Boolean
'File contents
Dim sMsg1 As String
Dim sMsg2 As String
Dim sMsgFinal As String
sFile1 = "C:\Users\foobar\Desktop\foo.txt"
sFile2 = "C:\Users\foobar\Desktop\foo2.txt"
sFileLast = "C:\Users\foobar\Desktop\fooFinal.txt"
sSearchStr = "*"
sDL = Chr(13) & Chr(10)
doOverwrite = True
sMsg1 = appendLines(sFile1, sSearchStr, sDL)
sMsg2 = appendLines(sFile2, sSearchStr, sDL)
sMsgFinal = sMsg1 & sDL & sMsg2
Call writeToFile(sMsgFinal, sFileLast, doOverwrite)
End Sub
Function appendLines(sFileName As String, sSearchStr As String, Optional sDL As String = " ") As String
Dim oFSO As FileSystemObject
Set oFSO = New FileSystemObject
Dim oFS As TextStream
Dim sStr As String
Dim sMsg As String
If oFSO.fileexists(sFileName) Then 'Check if file exists
On Error GoTo Err
Set oFS = oFSO.openTextFile(sFileName)
'Read file
Do While Not oFS.AtEndOfStream
sStr = oFS.ReadLine
If InStr(sStr, sSearchStr) Then
appendLines = sMsg
Else
sMsg = sMsg & sStr & sDL
End If
Loop
oFS.Close
Else
Call MsgBox("The file path (" & sFileName & ") is invalid", vbCritical)
End If
Set oFS = Nothing
Set oFSO = Nothing
Exit Function
Err:
Call MsgBox("Error occurred while reading the file.", vbCritical)
oFS.Close
Set oFS = Nothing
Set oFSO = Nothing
End Function
Sub writeToFile(sMsg As String, sFileName As String, Optional doOverwrite As Boolean = False)
Dim oFSO As FileSystemObject
Set oFSO = New FileSystemObject
Dim oFS As TextStream
On Error GoTo Err
If oFSO.fileexists(sFileName) Then
If doOverwrite Then
Set oFS = oFSO.openTextFile(sFileName, ForWriting)
Else
Set oFS = oFSO.openTextFile(sFileName, ForAppending)
End If
Else
Set oFS = oFSO.CreateTextFile(sFileName, True)
End If
Call oFS.write(sMsg)
oFS.Close
Set oFS = Nothing
Set oFSO = Nothing
Exit Sub
Err:
Call MsgBox("Error occurred while writing to the file.", vbCritical)
oFS.Close
Set oFS = Nothing
Set oFSO = Nothing
End Sub
You'll need to customize the appFiles routine as needed, by providing file names to sFile1, sFile2, and sFileLast; your desired search string to sSearchStr (you mentioned using "*"); a delimiter to separate lines (it's currently written to use a carriage return and new line); and a parameter deciding whether or not to overwrite the final file (if you find yourself running this multiple times with the same final file).
Here's another link that I used while writing the code above: link - Explains how to write to a file from within a macro
Hope this helps.
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