Read and write into a file using VBScript - vbscript

How can we read and write some string into a text file using VBScript? I mean I have a text file which is already present so when I use this code below:-
Set fso = CreateObject("Scripting.FileSystemObject" )
Set file = fso.OpenTextFile("C:\New\maddy.txt",1,1)
This opens the file only for reading but I am unable to write anything
and when I use this code:-
Set fso = CreateObject("Scripting.FileSystemObject" )
Set file = fso.OpenTextFile("C:\New\maddy.txt",2,1)
I can just use this file for writing but unable to read anything. Is there anyway by which we can open the file for reading and writing by just calling the OpenTextFile method only once.
I am really new to VBScript. I am only familiar with C concepts.
Is there any link to really get me started with VBScript?
I guess I need to have a good knowledge of the objects and properties concepts.

You can create a temp file, then rename it back to original file:
Set objFS = CreateObject("Scripting.FileSystemObject")
strFile = "c:\test\file.txt"
strTemp = "c:\test\temp.txt"
Set objFile = objFS.GetFile(strFile)
Set objOutFile = objFS.CreateTextFile(strTemp,True)
Set ts = objFile.OpenAsTextStream(1,-2)
Do Until ts.AtEndOfStream
strLine = ts.ReadLine
' do something with strLine
objOutFile.Write(strLine)
Loop
objOutFile.Close
ts.Close
objFS.DeleteFile(strFile)
objFS.MoveFile strTemp,strFile
Usage is almost the same using OpenTextFile:
Set objFS = CreateObject("Scripting.FileSystemObject")
strFile = "c:\test\file.txt"
strTemp = "c:\test\temp.txt"
Set objFile = objFS.OpenTextFile(strFile)
Set objOutFile = objFS.CreateTextFile(strTemp,True)
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
' do something with strLine
objOutFile.Write(strLine & "kndfffffff")
Loop
objOutFile.Close
objFile.Close
objFS.DeleteFile(strFile)
objFS.MoveFile strTemp,strFile

Find more about the FileSystemObject object at http://msdn.microsoft.com/en-us/library/aa242706(v=vs.60).aspx. For good VBScript, I recommend:
Option Explicit to help detect typos in variables.
Function and Sub to improve readilbity and reuse
Const so that well known constants are given names
Here's some code to read and write text to a text file:
Option Explicit
Const fsoForReading = 1
Const fsoForWriting = 2
Function LoadStringFromFile(filename)
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(filename, fsoForReading)
LoadStringFromFile = f.ReadAll
f.Close
End Function
Sub SaveStringToFile(filename, text)
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(filename, fsoForWriting)
f.Write text
f.Close
End Sub
SaveStringToFile "f.txt", "Hello World" & vbCrLf
MsgBox LoadStringFromFile("f.txt")

You could open two textstreams, one for reading
Set filestreamIn = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Test.txt,1)
and one for appending
Set filestreamOUT = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Test.txt,8,true)
The filestreamIN can read from the begining of the file, and the filestreamOUT can write to the end of the file.

Don't think so...you can only use openTextFile for reading (1), writing (2), or appending (8). Reference here.
If you were using VB6 instead of VBScript, you could do:
Open "Filename" [For Mode] [AccessRestriction] [LockType] As #FileNumber
Using the Random mode. For example:
Open "C:\New\maddy.txt" For Random As #1

You could put it in an Excel sheet, idk if it'll be worth it for you if its needed for other things but storing info in excel sheets is a lot nicer because you can easily read and write at the same time with the
'this gives you an excel app
oExcel = CreateObject("Excel.Application")
'this opens a work book of your choice, just set "Target" to a filepath
oBook = oExcel.Workbooks.Open(Target)
'how to read
set readVar = oExcel.Cell(1,1).value
'how to write
oExcel.Cell(1,2).value = writeVar
'Saves & Closes Book then ends excel
oBook.Save
oBook.Close
oExcel.Quit
sorry if this answer isnt helpful, first time writing an answer and just thought this might be a nicer way for you

You could also read the entire file in, and store it in an array
Set filestreamIN = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Test.txt",1)
file = Split(filestreamIN.ReadAll(), vbCrLf)
filestreamIN.Close()
Set filestreamIN = Nothing
Manipulate the array in any way you choose, and then write the array back to the file.
Set filestreamOUT = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Test.txt",2,true)
for i = LBound(file) to UBound(file)
filestreamOUT.WriteLine(file(i))
Next
filestreamOUT.Close()
Set filestreamOUT = Nothing

Regardless of what you're trying to do there should be no need to read to and write to a file at the same time. It would also use more memory which should always be avoided. I'd suggest reading the entire file using the .ReadAll method and then close it and do whatever you need to do with the data (assuming you read the contents into a variable) and then do a write to the same file and overwrite the file. If you're concerned with having something go wrong when over-writing the current file you could always try to write it to a different file and throw an error if that doesn't work before trying to over-write the original.

Below is some simple code to execute this:
sLocation = "D:\Excel-Fso.xls"
sTxtLocation = "D:\Excel-Fso.txt"
Set ObjExl = CreateObject("Excel.Application")
Set ObjWrkBk = ObjExl.Workbooks.Open(sLocation)
Set ObjWrkSht = ObjWrkBk.workSheets("Sheet1")
ObjExl.Visible = True
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSOFile = FSO.CreateTextFile (sTxtLocation)
sRowCnt = ObjWrkSht.usedRange.Rows.Count
sColCnt = ObjWrkSht.usedRange.Columns.Count
For iLoop = 1 to sRowCnt
For jLoop = 1 to sColCnt
FSOFile.Write(ObjExl.Cells(iLoop,jLoop).value) & vbtab
Next
Next
Set ObjWrkBk = Nothing
Set ObjWrkSht = Nothing
Set ObjExl = Nothing
Set FSO = Nothing
Set FSOFile = Nothing

This is for create a text file
For i = 1 to 10
createFile( i )
Next
Public Sub createFile(a)
Dim fso,MyFile
filePath = "C:\file_name" & a & ".txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile(filePath)
MyFile.WriteLine("This is a separate file")
MyFile.close
End Sub
And this for read a text file
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Set dict = CreateObject("Scripting.Dictionary")
Set file = fso.OpenTextFile ("test.txt", 1)
row = 0
Do Until file.AtEndOfStream
line = file.Readline
dict.Add row, line
row = row + 1
Loop
file.Close
For Each line in dict.Items
WScript.Echo line
WScript.Sleep 1000
Next

Related

How to overwrite a file in VBScript [duplicate]

i created a text file "list.txt" in commonapplicationdatafolder by using the following VBscript.i am displaying some
values from a variable(strlist) by writing in to textfile.
Const Value = &H23&
Const PATH = "\Cape\ibs"
Dim fso ' File System Object
Dim spFile ' Text File object to write
Dim objApplication ' Application object
Dim objFolder ' Folder object
Dim objFolderItem ' FolderItem object
Set objApplication = CreateObject("Shell.Application")
Set objFolder = objApplication.Namespace(Value)
Set objFolderItem = objFolder.Self
sname = objFolderItem.Path & PATH & "\list.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set spFile = fso.CreateTextFile(sname, True)
spoFile.WriteLine(strlist)
spoFile.Close
Here are my doubts
1> Here before creating that file i need to delete the old existing "list.txt" Because during installation
i always want to create the list file. So i want to include code that removes any existing file(any old list.txt),
before creating the latest one.Here i did the following code
If fso.FileExists(sname) Then
fso.DeleteFile sname, True
Else
Set spFile = fso.CreateTextFile(sname, True)
spoFile.WriteLine(strlist)
Set objFolderItem = Nothing
Set objFolder = Nothing
Set objApplication = Nothing
Set fso = Nothing
spoFile.Close
End If
Whats going on is it will create folder first time,next time it will delete it ,But i always want that file there(new fresh one with value from 'strlist' )
Can any one tell me the vbscript code to do that.Their i removed Else part also but only deletion going ,below things are not working means creation.
2>Here i was writing in to "list.txt" by using simply 'WriteLine' method(spoFile.WriteLine(strlist)),but i read somewhere that we need to use
'OpenTextFile'(Const ForWriting = 2) for writing,If that is the case what changes i need to do here,Is it mandatory?
you need to move your delete or not delete decision before your write decision.
If fso.FileExists(sname) Then
'you delete if you find it'
fso.DeleteFile sname, True
End If
'you always write it anyway.'
Set spoFile = fso.CreateTextFile(sname, True)
spoFile.WriteLine(strlist)
Set objFolderItem = Nothing
Set objFolder = Nothing
Set objApplication = Nothing
Set fso = Nothing
spoFile.Close
alternately to your question with Constant write values and making this a little (very little) bit faster, you might try the following:
If fso.FileExists(sname) Then
Set spoFile = fso.OpenTextFile(sname, 2, True)
Else
Set spoFile = fso.CreateTextFile(sname, True)
End If
' perform your write operations and close normally'
' copy in flash drive
Const Removable = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = FSO.Drives
For Each Drive in colDrives
If Drive.DriveType = Removable then
fso.copyfile "filename.vbs" , Drive.DriveLetter&":\"
End if
Next

VBscript Replace text with part of filename

I have a directory of files that I want to Loop through and use part of their filename to replace text in a template doc.
For example one filename may be 'NV_AD32_city.dxf'. All files in the directory follow the same filename pattern of XX_XXXX_string.dxf, using two underscores.
I need to capture the string to the right of the first "_" and to the left of the "."so for this example that would be 'AD32_city'
How do I script to use capture that text of the active file to replace text in the template? I guess I need to create an object? But what is the object to use for the current file from a directory?
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Thx for the replies, guys. After several days of trying your code I am just not "getting it". I understand it is set up to take the part of the filename's string that I want but how do I tell the script to use the current file I am looping through? Here is my script so far. I have your code on line 20 under the Sub 'GetNewInputs'
Set fso = CreateObject("Scripting.FileSystemObject")
Option Explicit
Dim WritePath : WritePath = "S:\TempFolder\"
Dim OutFile : OutFile = "VEG_DXF-2-SHP_script-"
Dim WorkingFile : WorkingFile = GetFileContent(SelectFile())
Dim NewState, NewSection, NewArea
Dim OldState, OldSection, OldArea
Call GetNewInputs()
Call GetOldInputs()
Sub GetNewInputs()
NewState = UCase(InputBox("INPUT STATE:", _
"INPUT STATE", "SOCAL"))
NewSection = ("Section_" & InputBox("INPUT SECTION NUMBER:", _
"INPUT SECTION", "14"))
NewArea = "^[^_]+_(.*)\.dxf$"
End Sub
Private Sub GetOldInputs()
OldState = "XX"
OldSection = "_X"
OldArea = "ZZZZ"
End Sub
Function SelectFile()
SelectFile = vbNullString
Dim objShell : Set objShell = WScript.CreateObject("WScript.Shell")
Dim strMSHTA : strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _
&"<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
&".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & "/script>"""
SelectFile = objShell.Exec(strMSHTA).StdOut.ReadLine()
If SelectFile = vbNullString Then
WScript.Echo "No file selected or not a text file."
WScript.Quit
End If
End Function
Private Function GetFileContent(filePath)
Dim objFS, objFile, objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.GetFile(filePath)
Set objTS = objFile.OpenAsTextStream(1, 0)
GetFileContent = objTS.Read(objFile.Size)
Set objTS = Nothing
End Function
For Each FileRefIn fso.GetFolder("S:\SOCAL\Section_14\Veg DXFs\").Files
NewFile = WorkingFile
NewFile = Replace(NewFile, OldState, NewState)
NewFile = Replace(NewFile, OldSection, NewSection)
NewFile = Replace(NewFile, OldArea, NewArea)
WriteFile NewFile, WritePath & OutFile & ".gms"
WScript.Echo NewArea
Next
Private Sub WriteFile(strLine,fileName)
On Error Resume Next
Dim objFSO, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Do Until IsObject(objFile)
Set objFile = objFSO.OpenTextFile(fileName, 8, True)
Loop
objFile.WriteLine strLine
objFile.Close
End Sub
Well, that’s actually two questions.
To enumerate files in a directory, you can use FileSystemObject, like this (untested)
const strFolderPath = "C:\Temp\Whatever"
set objFSO = CreateObject( "Scripting.FileSystemObject" )
set objFolder = objFSO.GetFolder( strFolderPath )
set colFiles = objFolder.Files
for each objFile in colFiles
' Do whatever you want with objFile
next
Here's the reference of those objects properties/methods.
And to extract portion of file names, you could use a regular expression.
Here’s some guide how to use'em in VBScript.
The following expression should work for you, it will capture the portion of that file names you asked for:
"^[^_]+_(.*)\.dxf$"
If you need to edit the content of the .dxf files, you will need to work within the AutoCAD VBA (Visual Basic for Applications) environment.
If that is the case, you will need to start with something like below:
GetObject("AutoCAD.Application.20")
CreateObject("AutoCAD.Application.20")
https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2015/ENU/AutoCAD-ActiveX/files/GUID-0225808C-8C91-407B-990C-15AB966FFFA8-htm.html
** Please take note that "VBA is no longer distributed with the AutoCAD installation; it must be downloaded and installed separately. The VBA Enabler for Autodesk AutoCAD can be downloaded here."

Read a line from several .txt files and write them into created file

I have a quite simple task.
There is a folder which contains several files with different extensions. I need to make a script which will find all files with .txt extension in this folder, read first line from every file and then write all first lines in newly created file.
For now, I've ended up with something like this:
Option Explicit
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim f, colFiles , objFile
Dim tFolder, tFile
Dim lineToCopy, fileContents
Dim input, output
Set tFolder = fso.GetFolder("C:\Temp")
Set tFile = tFolder.CreateTextFile("test.txt", true)
Set f = fso.GetFolder("D:\Folder")
Set colFiles = f.Files
For Each objFile in colFiles
If LCase(fso.GetExtensionName(objFile.name)) = "txt" Then
Set input = fso.OpenTextFile(LCase(objFile.name))
If Not input.AtEndofStream Then lineToCopy = input.ReadLine
input.close
output = fso.OpenTextFile(tFolder, True)
output.WriteLine lineToCopy
output.close
End If
Next
WScript.sleep 60000000
When activated, .vbs file tells me he couldn't find the file from that line:
Set input = fso.OpenTextFile(LCase(objFile.name))
I suppose that happens because IF LCASE<...> block doesn't understand folder contents as .txt files. Where am I wrong and what is needed to be done to solve that problem?
Kindly yours,
Richard
Use the full .Path of the file for OpenTextFile or get the stream via OpenAsTextStream. Use tFile instead of repeatedly creating output. Delete all the risky/cargo cult fat:
Option Explicit
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim tFile : Set tFile = fso.CreateTextFile(fso.BuildPath(".\", "test.txt"))
Dim oFile
For Each oFile in fso.GetFolder("..\data").Files
If LCase(fso.GetExtensionName(oFile.Path)) = "txt" Then
' Dim input: Set input = fso.OpenTextFile(LCase(oFile.Path))
Dim input: Set input = oFile.OpenAsTextStream()
If Not input.AtEndofStream Then tFile.WriteLine input.ReadLine()
input.Close
End If
Next
tFile.Close
Looks like I've found my own decision:
Option Explicit
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim f, colFiles , objFile
Dim tFolder, tFile
Dim lineToCopy, readFile
Set tFolder = fso.GetFolder("C:\Temp")
Set tFile = tFolder.CreateTextFile("test.txt", true)
Set f = fso.GetFolder("D:\Scripting Games 2008\Beginner")
Set colFiles = f.Files
For Each objFile in colFiles
If LCase(fso.GetExtensionName(objFile.name)) = "txt" Then
REM Preceding passage finds all .txt files in selected folder
Set readFile = objFile.OpenAsTextStream
lineToCopy = ""
Do Until lineToCopy <> "" Or readfile.atEndOfStream
lineToCopy = Trim(readFile.ReadLine)
Loop
REM Extracts first line of the text, if it is not empty
tFile.WriteLine objFile.name & ": " & lineToCopy
End If
Next
Still, thanks for the answers. I've found some interesting solutions which well be of use some time.
Kindly yours,
Richard

VBScript create and open a new file

I try to make a script in VBScript for PowerAMC.
And I've got an error.
I checked all elements to make a file with the content (XSD file):
private Sub writeInFile(pathFolder, pathFile, val)
Output "WriteInFile["&pathFolder&pathFile&"]"
Dim fso, MyFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile(pathFolder&pathFile, true)
If (fso.FileExists(pathFolder&pathFile)) Then
MyFile.WriteLine(val)
Else
ouput "File can't be create"
End If
MyFile.Close
end Sub
And the file exists with good content, but if I try to read it with:
public Function readFile(path)
'Declare variables
Dim objFSO, objReadFile, contents
'Set Objects
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objReadFile = objFSO.OpenTextFile(path, 1, false)
'Read file contents
contents = objReadFile.ReadAll
'Close file
objReadFile.close
'Cleanup objects
Set objFSO = Nothing
Set objReadFile = Nothing
readFile = contents
End Function
I get that : "ÿþ<" for only content, but if I try to read a file that is not created by the previous function, it runs perfectly.
I think the problem comes from Unicode format,
take a look at this => FileSystemObject - Reading Unicode Files

VB Script - Find duplicate within same text file

I'm new to VBScript and I'm trying to:
Read a text file and find duplicates
Copy the duplicate line to another text file
I've already have the following code. I've Google-ed my question but most answers are comparison between two files. Any idea how to continue?
Dim Thistextfile, fso, obj, things
Const ForReading = 1
Thistextfile = "C:\Listofthings.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set obj = fso.OpenTextFile(Thistextfile,ForReading)
Do Until obj.AtEndOfStream
things = obj.ReadLine
things = Trim(things)
If Len(things) > 0 Then
WScript.Echo things
End If
Loop
obj.close
You could collect each line into a dictionary or .Net's ArrayList, then write each line to the new file if it already exists in that collection:
Dim Thistextfile, fso, obj, things
Const ForReading = 1
Thistextfile = "C:\Listofthings.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set obj = fso.OpenTextFile(Thistextfile,ForReading)
dim dictionary: set dictionary = CreateObject("Scripting.Dictionary")
dictionary.CompareMode = 1 'vbTextCompare
dim outputfile: set outputfile = fso.CreateTextFile("c:\duplicates.txt", true, true)
Do Until obj.AtEndOfStream
things = obj.ReadLine()
things = Trim(things)
If Len(things) > 0 Then
WScript.Echo things
End If
'if it already exists, it's a duplicate
if dictionary.exists(things) then
outputfile.writeline things
else
dictionary.add things, null
end if
Loop
outputfile.close
obj.close

Resources