I know how to add text on top a text file but what I need is a way to ensure that at the point of reading the "old-text" no other process add text to that file. Imagine there exist one log file which will be fed on text from other processes. My current process is using FSO in two steps. The first step Open the text in "read" mode then grab the whole content with .ReadAll and close the file afterwards. The next step is to open this file in "write" mode and add new text on top of the old Content and close the file.
My problem is that at the moment when I read the whole content another process could write at this time an additional log-entry (which I could not grab). This results in losing the log-entry from the other process. Below is my current workaround...
Dim strContentsOLD, sNewLogEntry
Dim sPFnStartLogGol : sPFnStartLogGol = "C:\Path\to\logfile.txt"
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim oLogfile : Set oLogfile = oFSO.OpenTextFile(sPFnStartLogGol, 1, True) 'ForReading = 1 / True = create new if not exist
If IsObject(oLogfile) Then 'already open for Reading
If oFSO.GetFile(sPFnStartLogGol).Size > 0 Then strContentsOLD = oLogfile.ReadAll 'read all old log-entries
oLogfile.Close 'close log-file
sNewLogEntry = "This is a new Log entry" 'log entry
Set oLogfile = oFSO.OpenTextFile(sPFnStartLogGol, 2) 'open again but ForWriting = 2
oLogFile.write sNewLogEntry & vbCrLf & strContentsOLD 'add old entries underneath new entry
oLogFile.close
End If
Related
I have a custom-button in my excel sheet, and when the user clicks it, the code enables the user to upload a file, and then code modifies the uploaded file, and stores the modified contents in a String variable s. -
Option Explicit
Sub Button1_Click()
Dim fso As Object, ts As Object, doc As Object
Dim data As Object, filename As String
Dim ws As Worksheet
Set ws = ActiveSheet
' select file
With Application.FileDialog(msoFileDialogFilePicker)
If .Show <> -1 Then Exit Sub
filename = .SelectedItems(1)
End With
' read file and add top level
Set doc = CreateObject("MSXML2.DOMDocument.6.0")
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpentextFile(filename)
doc.LoadXML Replace(ts.readall, "<metadata>", "<root><metadata>", 1, 1) & "</root>"
ts.Close
' import data tag only
Dim s As String
Set data = doc.getElementsByTagName("data")(0)
s = data.XML
' MsgBox s
' replace the original XML file with contents of variable s here
If MsgBox(s & vbCrLf, vbYesNo) = vbYes Then
Application.SendKeys ("%lt")
Else
MsgBox "Ok"
End If
End Sub
Let's say I clicked the button and uploaded an XML file C:/My Folder/sample.xml. Now the code modifies it, and updates the file (with the new contents stored in variable s). Here's a representative image - (the modified contents is direct value of s variable)
How do I achieve the above? Kindly guide... Thanks!
See CreateTextFile method of a TextStream Objects
Set ts = fso.CreateTextFile(filename, True)
ts.Write s
ts.Close
Why not continue with XML methods by loading the wanted string again (after Set data = doc.getElementsByTagName("data")(0)):
doc.LoadXML data.XML
doc.Save filename
Side note to posted code
It's worth mentioning that the somehow peculiar insertion of a starting <root> and closing </root> tag into the loading xml string via
doc.LoadXML Replace(ts.readall, "<metadata>", "<root><metadata>", 1, 1) & "</root>"
is a only a workaround rebuilding a well-formed xml input thus avoiding
Error `-1072896683 XML document must have a top level element.`
So imo you might consider changing your pattern files to include metadata not at top-level, but at a subsequent hierarchy level already in design to provide for a loadable, well-formed xml markup.
How do I open a text file and look for a specific string?
I want that the string "productactivated=true" determines whether to display a message on the Userform telling the user to activate.
A few days ago I asked for help with opening a text file and doing some reading and writing, so I came up with this
Open "application.txt" For Output As #1
ClngLine = lngLine + 1
Line Input #f, strLine
If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 Then
MsgBox "Search string found in line " & lngLine, vbInformation
blnFound = True
Close #1
For your solution two files will be used showing how to read and write to text files. The writing was added just to show you how to do it but does not seem to be needed for your solution per your question statement. For this solution purpose, all the files are in the same folder.
The first file is the file being read from. For the demo purpose, since not data was supplied it was created with the following data and named "TextFile.txt":
This is the first line.
This is the second line and has productactivated=true.
Third line lays here.
productactivated=true is found in line four.
The second file is the file being written to. For the demo purpose just to show how it is done, but per your question isn't needed, and named "TextFile.txt":
This is the first line.
This is the second line and has productactivated=true.
Third line lays here.
productactivated=true is found in line four.
The VBA code:
Sub search_file()
Const ForReading = 1, ForWriting = 2
Dim FSO, FileIn, FileOut, strSearch, strTmp
'FileSystemObject also called as FSO, provides an easy object based model to access computer’s file system.
Set FSO = CreateObject("Scripting.FileSystemObject")
'Set FileIn to the file for reading the text into the program.
Set FileIn = FSO.OpenTextFile("TextFile.txt", ForReading)
'Set FileOut to the file for writing the text out from the program.
'This was added just to show "how to" write to a file.
Set FileOut = FSO.OpenTextFile("TextFileRecordsFound.txt", ForWriting, True)
'Set the variable to the string of text you are looking for in the file you are reading into the program.
strSearch = "productactivated=true"
'Do this code until you reach the end of the file.
Do Until FileIn.AtEndOfStream
'Store the current line of text to search to work with into the variable.
strTmp = FileIn.ReadLine
'Determines whether to display a message
'(Find out if the search text is in the line of text read in from the file.)
If InStr(1, strTmp, strSearch, vbTextCompare) > 0 Then
'Display a message telling the user to activate.
MsgBox strSearch & " was found in the line:" & vbNewLine & vbNewLine & strTmp, , "Activate"
'Write the line of text to an external file, just to demo how to.
FileOut.WriteLine strTmp
End If
Loop 'Repeat code inside Do Loop.
'Close files.
FileIn.Close
FileOut.Close
End Sub
Whenever a specific Excel file is in use, I'd like to prevent anyone else editing it.
ie. "This file is currently being edited by John Dow, and it will now close".
I'm looking for something simple.
Any ideas?
Thank you,
D.
I'm going to add an answer to this which I'll have to say is nowhere near perfect (blatantly trying to avoid down-votes for trying to do something that isn't really necessary).
I just wanted to see if you could extract the name of the person that has it open - after all, it does normally give the name of the person who has it locked for editing when you first open a workbook.
When you open an Excel file a hidden lock file is created in the same folder. The lock file has the same name as the original with ~$ appended to the front of the file name.
I found you can't copy the lock file using the VBA FileCopy as you get a Permission denied error, but you can using the FileSystemObject CopyFile.
The thinking behind my method is to copy the lock file and change it to a text file. You can then pull the user name from it and compare it against the current user name - if it's different then report that and close the file.
Note - I wouldn't use this in a project as there seems to be a few places it can fall over, and Excel will generally tell you that someone else has it open anyway. It was more of a coding exercise.
Private Sub Workbook_Open()
Dim ff As Long
Dim sLockFile As String
Dim sTempFile As String
Dim oFSO As Object
Dim XLUser As String, LoggedUser As String
Dim fle As Object
sLockFile = ThisWorkbook.Path & Application.PathSeparator & "~$" & ThisWorkbook.Name
sTempFile = Replace(sLockFile, "~$", "") & "tmp.txt"
'Create copy of lock file as a text file.
Set oFSO = CreateObject("Scripting.FileSystemObject")
oFSO.CopyFile sLockFile, sTempFile, True
'Read the first line from the text file.
ff = FreeFile()
Open sTempFile For Input Lock Read As #ff
Line Input #1, XLUser
Close ff
'Remove the current user from the text.
'Need to check this so that it doesn't close because it sees the current user name.
XLUser = Replace(XLUser, Application.UserName, "")
'Extract name from text string.
'There is a double space in the InStr section.
'The double exclamation mark is a single character - I don't know the code though.
'Unicode U+0203C I think.
XLUser = Replace(Left(XLUser, InStr(XLUser, " ") - 1), "", "")
'Remove hidden attributes so temp file can be deleted.
Set fle = oFSO.GetFile(sTempFile)
fle.Attributes = 0
Kill sTempFile
'If there's still text then it's a user name - report it and close.
If Len(Trim(XLUser)) > 0 Then
MsgBox "Workbook is already open by " & XLUser
ThisWorkbook.Close SaveChanges:=False
End If
End Sub
Having put all that, this code is probably safer:
Private Sub Workbook_Open()
If ThisWorkbook.ReadOnly Then
MsgBox "Is opened in read only.", vbOKOnly
ThisWorkbook.Close SaveChanges:=False
End If
End Sub
I have this sample code in VBA:
iFileNum = FreeFile()
Open fileLocation For Input As #1
Do While Not EOF(iFileNum)
Line Input #iFileNum, sText
Loop
How do I restart iFileNum to go back to the beginning of the file?
I believe you can use it:
If EOF(fileNum) Then
Seek fileNum, 1
End If
Seek command moves the pointer to anywhere in the file.. so the 1 moves the pointer to the start of the file.
Still, Ho1 answer above needs to be considered.
The FileSystemObject Object might give you more control:
''Library: Windows Script Host Object Model
Dim fso, ts
Const ForReading = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile("c:\docs\test.txt", ForReading, True)
a = ts.Readall
Debug.Print a
aa = Split(a, vbCrLf)
Debug.Print aa(0)
If you meant that you want to read another file, then you have to close this file and open the other file. Otherwise, if you mean that you want to read the same file again, then that's the same that you will have to close it and re-open it.
However, I'd suggest that in that case you just cache the contents of the file in memory rather than reading it multiple times (unless the content of it has changed of course).
I have one folder with multiple text files that I add one text file to every day. All text files are in the same format and are pipe delimited.
Is it possible to create code for excel that will automatically import the data from the multiple text files into one worksheet?
I found some code that would import all the text files from the folder, but only if I changed it all to comma delimited first. Also, I could not get it to update if I added files to the folder.
Any help would be greatly appreciated!
A good way to handle files in general is the 'FileSystemObject'. To make this available in VBA you need to add a reference to it:
(select the Tools\References menu. In the References dialog, select 'Microsoft Scripting Runtime')
The following code example will read all files in a folder, reads their content one line at a time, split each line into | separated bits, and writes theses bits to the active sheet starting at cell A1, one row per line.
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
' Get a FileSystem object
Set fso = New FileSystemObject
' get the directory you want
Set folder = fso.GetFolder("D:\YourDirectory\")
' set the starting point to write the data to
Set cl = ActiveSheet.Cells(1, 1)
' Loop thru all files in the folder
For Each file In folder.Files
' Open the file
Set FileText = file.OpenAsTextStream(ForReading)
' Read the file one line at a time
Do While Not FileText.AtEndOfStream
TextLine = FileText.ReadLine
' Parse the line into | delimited pieces
Items = Split(TextLine, "|")
' Put data on one row in active sheet
For i = 0 To UBound(Items)
cl.Offset(0, i).Value = Items(i)
Next
' Move to next row
Set cl = cl.Offset(1, 0)
Loop
' Clean up
FileText.Close
Next file
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
the sub is deliberately simplified to remain clear (i hope) and will need work to be made robust (eg add error handling)
Sounds like it'd be easiser to run a script to cycle thru all the files in the directory, create a new file composed of all the files' contents as new lines, and save that as a csv. something like:
import os
basedir='c://your_root_dir'
dest_csv="<path to wherever you want to save final csv>.csv"
dest_list=[]
for root, subs, files in os.walk(basedir):
for f in files:
thisfile=open(basedir+f)
contents=thisfile.readlines()
dest_list.append(contents)
#all that would create a list containing the contents of all the files in the directory
#now we'll write it as a csv
f_csv=open(dest_csv,'w')
for i in range(len(dest_list)):
f_csv.write(dest_list[i])
f_csv.close()
You could save a script like that somewhere and run it each day, then open the resulting csv in excel. This assumes that you want to get the data from each file in a particular directory, and that all the files you need are in one directory.
You can use Schema.ini ( http://msdn.microsoft.com/en-us/library/ms709353(VS.85).aspx ), Jet driver and Union query, with any luck.