I'm trying to read the first few characters in large (>15MB) files in excel. Right now, I'm using the typical:
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
For Each myFile In mySource.Files
With New Scripting.FileSystemObject
With .OpenTextFile(myFile, ForReading)
test_str = .ReadLine
'Do things
End With
End With
Next
The issue is with large files, I (believe) you're loading into memory the WHOLE thing only to read the first few characters. Is there a way to just extract the first 6 characters?
An alternative to the FileSystemObject would be ADO
However, your statement
I (believe) you're loading into memory the WHOLE thing only to read
the first few characters.
is wrong.
What I think is misleading you is the fact that you are not exiting the loop after you read the first line. You get what you want by reading line by line but you are not closing the file right away. It's a good programmers practice to always close any objects you initiate in your code. Don't just leave it hanging and don't rely on the environment to kill them.
Consider the below code as an alternative to yours and see if there is any efficiency difference
Option Explicit
' add references to Microsoft Scripting Runtime
' Tools >> References >> Microsoft Scripting Runtime
Sub Main()
Dim fileName As String
' make sure to update your path
fileName = "C:\Users\FoohBooh\Desktop\Project.txt"
ReadTxtFile fileName
End Sub
Sub ReadTxtFile(fileName)
Dim oFSO As New FileSystemObject
Dim oFS As TextStream
Set oFS = oFSO.OpenTextFile(fileName)
Dim content As String
content = oFS.ReadLine
With Sheets(1).Range("A1")
.ClearContents
.NumberFormat = "#"
.Value = content
End With
oFS.Close
Set oFS = Nothing
End Sub
The above code reads the first line of a .txt file into cell A1 of the first sheet. Remember to set a fileName variable to a full path.
Related
It is easy to find in the internet a way of write into a txt file but all I find is always writing in the very last line:
Sub write_log(sentence_to_be_written As String)
Dim strFile_Path As String
strFile_Path = "C:\Users\[user_name]\Desktop\log.txt"
Open strFile_Path For Append As #1
Print #1, Now() & " --> " & sentence_to_be_written
Close #1
End Sub
I would like to write instead into the first line of the txt file.
Try the next code, please. It needs a reference to Microsoft Scripting Runtime. It can be adapted to work without such a reference. In fact, I will also post a pice of code able to automatically add the necessary reference... It is possible to read the text using standard VBA Open, but only concatenating line by line and I think this solution is more elegant:
Sub write_log_OnTop(sentence_to_be_written As String)
'It neds a reference to 'Microsoft Script Runtime'
Dim strFile_Path As String, strText As String
Dim fso As New FileSystemObject, txtStr As TextStream
strFile_Path = "C:\Users\Fane Branesti\OneDrive\Desktop\log.txt"
If Dir(strFile_Path) <> "" Then 'check if file exists
Set txtStr = fso.OpenTextFile(strFile_Path)
strText = txtStr.ReadAll
txtStr.Close
Else
MsgBox "Wrong file path...": Exit Sub
End If
strText = Now() & " --> " & sentence_to_be_written & vbCrLf & strText
Open strFile_Path For Output As #1
Print #1, strText
Close #1
End Sub
And Microsoft Scripting Runtime reference can be automatically add by running of the next code:
Private Sub Add_Scripting_Reference() 'Adds 'Microsoft Scripting Runtime'
Dim wb As Workbook, r As Reference
Set wb = ThisWorkbook
For Each r In wb.VBProject.References
If r.name = "Scripting" Then Exit Sub
Next
wb.VBProject.References.AddFromFile Environ("windir") & "\system32\scrrun.dll"
End Sub
If you do not want the reference, even if I would not understand such a choice, it is enough to comment/replace the code line
Dim fso As New FileSystemObject, txtStr As TextStream
with:
Dim fso As Object, txtStr As Object: Set fso = CreateObject("Scripting.FileSystemObject")
There is no command to add text at the top (or the middle) of any file. I never heard about such command in any programming language. It's about (disk-)space management, if you add a line of text in front of any other text, the existing text needs to be moved, and this is a rather complicated operation.
If you deal with short files, you could solve that by reading the content of the file into memory and then recreate the file by first writing the new line(s) and the add the content - as Joerg Wood suggested in the comments. However, this would need lot of memory and/or disk IO if the file gets larger, and the process has to be repeated every time you want to add a line - maybe not an issue if you write only one line per hour, but quite an issue if you are writing multiple lines per second.
It seems you are writing a log file and probably you want to see what was going on lately. You could use a windows version of the tail command (that comes from Unix) or use the powershell command Get-Content "C:\Users\[user_name]\Desktop\log.txt" -Tail 10 (see https://stackoverflow.com/a/188126/7599798) for that - it will display the last lines of a file.
An alternative could be to write the log into an Excel sheet or a database - in both cases it is easy to fetch the data in any order.
I am having trouble coding this VBA Macro for a bunch of CSV files (10000). After searching I found/used this for my code:
Loop through files in a folder using VBA? . It doesn't seem to work and I'm not sure why... I have tried the While loop but it is very slow I don't know if it can finish running.
Sub LoopThroughFiles()
Dim MyObj As Object, MySource As Object, file As Variant
file = Dir("C:\Users\me\Desktop\test")
While (file <> "")
If InStr(file, "test") > 0 Then
'// my macro code is here
Exit Sub
End If
file = Dir
Wend
End Sub
What else should I try changing? Where did I go wrong? I have also tried using this code https://www.thespreadsheetguru.com/the-code-vault/2014/4/23/loop-through-all-excel-files-in-a-given-folder but am unsure what else to change besides the directory and the 'Change First Worksheet's Background Fill Blue.
Also tried this http://www.ozgrid.com/VBA/loop-through.htm which seems pretty fool proof but I cant get it to work...
UPDATES FROM L8N
Option Explicit
Sub looper()
Dim fso As Scripting.FileSystemObject
Dim aFolder As Scripting.Folder
Dim aFile As Scripting.file
Dim aText As Scripting.TextStreame
Dim singleLine As String
Set fso = New FileSystemObject
Set aFolder = fso.GetFolder("C:\Users\ME\Desktop\test") 'set path to the folder that contains the files
For Each aFile In aFolder.Files 'loops through every file in the top level of the folder
If InStr(1, vbBinaryCompare) > 0 Then
Range("A2:D200210").Clear 'what i want to happen to every file
Set aText = fso.OpenTextFile(aFile.Path, ForReading)
Do Until aText.AtEndOfStream
singleLine = aText.ReadLine 'read line into string, every call advances the line counter by one, this prevents skipping lines
If InStr(1, singleLine, vbBinaryCompare) > 0 Then Debug.Print singleLine ' in line case, prints line if target value is found
Loop
End If
Next aFile
Debug.Print "finished"
End Sub
It runs, but it does not seem to implement the changes I want (Range("A2:D200210").Clear ) to each file. Also the string name for my code does not matter, the info in the sheet does not either. My original code was to test if it looped at all.
I don't know exactly what you are trying to do, the code you have does the following:
file = Dir("C:\Users\me\Desktop\test") writes the filename to file if the file "test" exists, if you use Dir("C:\Users\me\Desktop\test\") the function will return the name of the first file it finds.
On subsequent runs it will return the next file in the folder, keep in mind that this is a global call, so if you call the function somewhere else it may interfere. Using the Microsoft Scripting Engine Runtime is preferable in most cases apart from quick checks if a file exists.
If InStr(file, "test") > 0 Then You test if "test" is a part of the filename, so far so good, but keep in mind to tell InStr how it should compare the two strings. InStr accepts four parameters (all of them optional), be sure to pass the proper ones. The microsoft documentation is actually quite decent.
Is this what you wanted? I think you might be looking for something inside the .csv file, if so I can extend the script below.
A simple way to loop though all files in a folder is attached below:
Option Explicit
Sub looper()
Dim fso As Scripting.FileSystemObject
Dim aFolder As Scripting.Folder
Dim aFile As Scripting.file
Dim aText As Scripting.TextStream
Dim targetName As String 'string that identifies files
Dim targetWord As String 'string that identifies line inside csv file
Dim singleLine As String
Set fso = New FileSystemObject
Set aFolder = fso.GetFolder("C:\Users\Me\Desktop\test") 'set folder that contains the files
targetName = "someFileName"
targetWord = "someString"
For Each aFile In aFolder.Files 'loops through every file in the top level of the folder
If InStr(1, aFile.Name, targetName, vbBinaryCompare) > 0 Then
Debug.Print "Found a matching File: "; aFile.Name
Set aText = fso.OpenTextFile(aFile.Path, ForReading)
Do Until aText.AtEndOfStream
singleLine = aText.ReadLine 'read line into string, every call advances the line counter by one, this prevents skipping lines
If InStr(1, singleLine, targetWord, vbBinaryCompare) > 0 Then Debug.Print singleLine ' in line case, prints line if targer value is found
Loop
End If
Next aFile
Debug.Print "finished"
End Sub
Bonus Info:
Use option explicit to make sure all variables are declared properly
Edit:
Not able to add comments to your post yet, so I'll put the response here.
If InStr(1, vbBinaryCompare) > 0 Then this line is now broken as it will always return 0. If you want to loop through every file just omit the IF-Contitional or set it to If True Then.
Range("A2:D200210").Clear is a so called implicit reference, the Range Object refers to the "Global" Worksheet. Every time this piece of code is executed, the change happens on the "Global" Worksheet, a nice answer by Mathieu Guindon from just recently explains this.
It runs, but it does not seem to implement the changes I want (Range("A2:D200210").Clear ) to each file. Also the string name for my code does not matter, the info in the sheet does not either. My original code was to test if it looped at all.
So from what I can see you try to delete everything but the first row inside a .csv file. A .csv file is not a worksheet(even though you can import it into excel), so you can't use the Range property.
Fortunately, there is an even easier way to do this, just use the Microsoft Scripting Runtime to edit the .csv file.
Set aText = aFile.OpenAsTextStream(ForReading) ' open file in read mode
singleLine = aText.ReadLine ' read the first line and store it
Set aText = aFile.OpenAsTextStream(ForWriting) ' open file in write mode
aText.Write (singleLine) 'write the line you saved before
Or even more compact:
aFile.OpenAsTextStream(ForWriting).Write aFile.OpenAsTextStream(ForReading).ReadLine 'overwrites the file with what was written in the first line.
The advantage with the longer code is the ability to use the string somewhere else, for example storing it somewhere in your workbook.
There are a number of similar posts but nothing that does exactly what I want as simply as it needs to be for me to understand
I want to use Access 2007 VBA to open a csv file and replace the column headings row ie:
OldColumn1,OldColumn2
1,2
with
NewColumn1,NewColumn2
1,2
ie without disturbing the rump of data.
Then save and close.
I have tried this code, but it deletes my data:
Sub WriteFile()
Dim OutputFileNum As Integer
Dim PathName As String
PathName = Application.ActiveWorkbook.Path
OutputFileNum = FreeFile
Open PathName & "\Test.csv" For Output Lock Write As #OutputFileNum
Print #OutputFileNum, "NewCol1" & "," & "NewCol2"
Close OutputFileNum
End Sub
Import or link to the .csv so that you have the recordset in your Access 2007 databases.
Write a query with NewColumn[x] as an alias for OldColumn[x].
Write vba code to use TransferText functionality or make a macro to do the same to export your query as a .csv file (overwriting the original csv if you want/need).
Obviously, there are plenty of bonus things you could do to automate and reproduce this concept for any number or types of files. But the above solution should work in an all MS Access environment.
Let me know if you would like details on any of these steps.
Further to my earlier comment, please see the method which uses the Excel reference:
Public Sub EditCsv()
Dim xlApp As Object
dim xlWbk As Object
Dim xlWst As Object
Set xlApp = CreateObject("Excel.Application")
Set xlWbk = xlApp.Workbooks.Open ".../Test.csv" 'Amend this to your needs
Set xlWst = xlWbk.Sheets(1)
'This assumes the columns are at the beginning of the file
xlWst.Range("A1") = "My New Column Name"
xlWst.Range("B1") = "My New Second Column Name"
xlWbk.Close -1 'Close and save the file here
xlApp.Quit
Set xlApp = Nothing
Set xlWbk = Nothing
Set xlWst = Nothing
End Sub
I have a file which is manually added or modified based on the inputs. Since most of the contents are repetitive in that file, only the hex values are changing, I want to make it a tool generated file.
I want to write the c codes which are going to be printed in that .txt file.
What is the command to create a .txt file using VBA, and how do I write to it
Use FSO to create the file and write to it.
Dim fso as Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile as Object
Set oFile = FSO.CreateTextFile(strPath)
oFile.WriteLine "test"
oFile.Close
Set fso = Nothing
Set oFile = Nothing
See the documentation here:
http://technet.microsoft.com/en-us/library/ee198742.aspx
http://technet.microsoft.com/en-us/library/ee198716.aspx
Open ThisWorkbook.Path & "\template.txt" For Output As #1
Print #1, strContent
Close #1
More Information:
Microsoft Docs : Open statement
Microsoft Docs : Print # statement
Microsoft Docs : Close statement
wellsr.com : VBA write to text file with Print Statement
Office Support : Workbook.Path property
To elaborate on Ben's answer:
If you add a reference to Microsoft Scripting Runtime and correctly type the variable fso you can take advantage of autocompletion (Intellisense) and discover the other great features of FileSystemObject.
Here is a complete example module:
Option Explicit
' Go to Tools -> References... and check "Microsoft Scripting Runtime" to be able to use
' the FileSystemObject which has many useful features for handling files and folders
Public Sub SaveTextToFile()
Dim filePath As String
filePath = "C:\temp\MyTestFile.txt"
' The advantage of correctly typing fso as FileSystemObject is to make autocompletion
' (Intellisense) work, which helps you avoid typos and lets you discover other useful
' methods of the FileSystemObject
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim fileStream As TextStream
' Here the actual file is created and opened for write access
Set fileStream = fso.CreateTextFile(filePath)
' Write something to the file
fileStream.WriteLine "something"
' Close it, so it is not locked anymore
fileStream.Close
' Here is another great method of the FileSystemObject that checks if a file exists
If fso.FileExists(filePath) Then
MsgBox "Yay! The file was created! :D"
End If
' Explicitly setting objects to Nothing should not be necessary in most cases, but if
' you're writing macros for Microsoft Access, you may want to uncomment the following
' two lines (see https://stackoverflow.com/a/517202/2822719 for details):
'Set fileStream = Nothing
'Set fso = Nothing
End Sub
an easy way with out much redundancy.
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim Fileout As Object
Set Fileout = fso.CreateTextFile("C:\your_path\vba.txt", True, True)
Fileout.Write "your string goes here"
Fileout.Close
Dim SaveVar As Object
Sub Main()
Console.WriteLine("Enter Text")
Console.WriteLine("")
SaveVar = Console.ReadLine
My.Computer.FileSystem.WriteAllText("N:\A-Level Computing\2017!\PPE\SaveFile\SaveData.txt", "Text: " & SaveVar & ", ", True)
Console.WriteLine("")
Console.WriteLine("File Saved")
Console.WriteLine("")
Console.WriteLine(My.Computer.FileSystem.ReadAllText("N:\A-Level Computing\2017!\PPE\SaveFile\SaveData.txt"))
Console.ReadLine()
End Sub()
I would like to append a text (.txt) file backwards is this possible?
By backwards I mean writing text from bottom to top rather then the standards top to bottom.
Why because the txt file I want to compile is read so that items at the top of the list are given priority to those at the bottom.
I can't think of any other way than to create a new file whenver you want to insert data at the top and then delete/rename the old one and rename the new file to the new one.
Not sure exactly your requirements BUT the easiest way in VBA is to
1. Add a reference to the Microsoft Scripting Runtime.
Public Sub Reverse()
Dim lReverseString As String
Dim lFSO As FileSystemObject
Set lFSO = New Scripting.FileSystemObject
With lFSO.OpenTextFile("SourceName", ForReading)
While Not .AtEndOfStream
' Note if you are looking to read a line at at a time use .ReadLine Instead of .Read
lReverseString = .Read & lReverseString
Wend
End With
' now you have a string in reverse
With lFSO.CreateTextFile("TargetName", True, False)
.Write lReverseString
.Close
End With
End Sub
This is a basic form which should get you going.
How about an array? It would not be suitable with a very large file:
Dim fs As Object
Dim ts As Object
Dim AllTextArray As Variant
''Late binding, no reference required
Set fs = CreateObject("Scripting.FileSystemObject")
''ForReading=1
Set ts = fs.OpenTextFile("c:\docs\BookX.csv", 1)
AllTextArray = Split(ts.ReadAll, vbCrLf)
For i = UBound(AllTextArray) To 0 Step -1
Debug.Print AllTextArray(i)
Next
If it's just writing each paragraph or sentence in the reverse order than it appears:
Sub Test()
Dim currentDocument As Document
Set currentDocument = ActiveDocument
Dim sourceDocument As Document
Set sourceDocument = Documents.Add("c:\words.txt")
Dim i As Long
For i = sourceDocument.Paragraphs.Count To 1 Step -1
currentDocument.Range.InsertAfter sourceDocument.Paragraphs(i).Range.Text
DoEvents
Next
sourceDocument.Close wdDoNotSaveChanges
End Sub