Find and replace multiple file in vbs - vbscript

I am trying to implement a find and replace for all files in a folder using a vbs script, here is what I have so far
Dim fso,folder,files,oldFileContents,newFileContents,FIND,REPLACE
FIND = "textToBeReplaced"
REPLACE = "localhost"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("HTML")
Set files = folder.Files
For each item In files
oldFileContents = GetFile(item.Path)
newFileContents = replace(oldFileContents,FIND,REPLACE,1,-1,1)
WriteFile FileName,newFileContents
Next
but when I try to run it I get and error, "Type Mismatch: 'GetFile'", what am I doing wrong?

The problem should be solved with code like:
' Constants Mr Gates forgot (but cf. vbTextCompare)
Const ForReading = 1
Const ForWriting = 2
' Configuration constants
Const csFind = "pdf"
Const csRepl = "puf"
' Dim & init for vars needed on *this* level
Dim oFS : Set oFS = CreateObject("Scripting.FileSystemObject")
Dim sTDir : sTDir = oFS.GetAbsolutePathName("..\data\test")
Dim oFile
For Each oFile In oFS.GetFolder(sTDir).Files
WScript.Echo "looking at", oFile.Name
' Dim & init for vars needed on *this* level
Dim sContent : sContent = goFS.GetFile(oFile.Path)
' For Skytunnels and other air-coders
WScript.Echo "content is not", sContent
' you got oFile, so use it; no need for .GetFile()
sContent = oFile.OpenAsTextStream(ForReading).ReadAll()
WScript.Echo "qed! content is", sContent
' Replace(expression, find, replacewith[, start[, count[, compare]]])
' don't use magic numbers; vbTextCompare is even pre-defined
sContent = Replace(sContent, csFind, csRepl, 1, -1, vbTextCompare)
WScript.Echo "new content", sContent
oFile.OpenAsTextStream(ForWriting).Write sContent
sContent = oFile.OpenAsTextStream(ForReading).ReadAll()
WScript.Echo "new content straight from file", sContent
WScript.Echo "------------------"
Next
output:
...
------------------
looking at 0000000000012345.20120302.pdf
content is not E:\trials\SoTrials\answers\9117277\data\test\0000000000012345.20120302.pdf
qed! content is This is the content of 0000000000012345.20120302.pdf
new content This is the content of 0000000000012345.20120302.puf
new content straight from file This is the content of 0000000000012345.20120302.puf
Important points:
Don't use a Dim-all-vars-ever-used-line at the top of your script
Avoid creation of unnecessary vars (folder, files, *contents), use
the vars you have properly (item==oFile)
.GetFile() returns a File object, not the file's content

You missed out the fso. on
oldFileContents = fso.GetFile(item.Path)
and
fso.WriteFile FileName,newFileContents
EDIT: as per discussion below, please note this answer was only meant to show where your error was occurring. It was assumed that your intent was to develop your code further once your got past this error, which if so, I’m sure you’ve already seen Ekkehard has provided some very helpful guidance on his answer.

Related

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

Too many iterations in loop

This script collects all files in a folder and renames the files by appending the number of lines to the file name. All files are .txt files. The method (since fso.MoveFile and fso.DeleteFile are too particular, generating permissions errors) is to
create the text files,
then create a collection of the files in the folder,
then copy each file into the same folder with a new name, and
finally to delete the original file that was copied.
The script works ok, unless there are no empty text files in the collection. What happens is, the collection gets rebuilt with the new files and the script once again renames the files. I know I can prevent this by checking each file for the existence of certain repeating character strings, but I'd like to know what's happening? Why does the script rebuild the file collection and run through them again renaming each one? This continues on until I kill the process.
Another interesting factoid is, if I happen to trap an empty text file, my message is displayed and the script stops there, but has still reprocessed the first file in the collection a second time. Note that the empty file just happens to be the last one in the collection, but the first filed is once again processed.
So, by design a created text file named 'ab0.txt' gets renamed to 'ab0-15.txt' since it has 15 lines of text in it. What happens is this newly renamed file looks like 'ab0-15-15-15-15-15-15-15-15-15-15.txt'
Questions: What's going on? And is there a better and more efficient way to accomplish this objective?
Here's the code pertinent to the issue:
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(strSaveTo)
Set colFiles = oFolder.Files
' Call Sub to copy and rename
ChangeFileName colFiles
MsgBox("File renaming complete.")
' Exit code
Sub ChangeFileName(collectionSet)
Const ForReading = 1
Dim oFile
For Each oFile In collectionSet
Set LineCnt = fso.OpenTextFile(oFile, ForReading)
If oFile.Size = 0 then
'if this msg is not included, weird things happen
MsgBox("The file named " & oFile & _
" is empty.You may want to verify and manually delete it.")
'[I had some code in here to delete the empty file, but nothing worked]
Else
Do While LineCnt.AtEndOfStream <> True
LineCnt.SkipLine
Loop
lineVar = lineCnt.Line-1
strNewFile = strSaveTo & Left(oFile.name, Len(oFile.name)-4) & _
"-" & lineVar & ".txt"
fso.CopyFile oFile, strNewFile
LineCnt.Close
fso.DeleteFile oFile, True
End If
Next
End Sub
I've heard anecdotal evidence that the Files collection is "live", meaning that newly created files will be added to the collection and iterated over, but I can't find any documentation that says one way or the other. In any case, it's probably a good idea to copy the File objects in the collection to an array first before processing them:
Dim oFile
Dim fileArray()
Dim i
ReDim fileArray(collectionSet - 1)
i = 0
For Each oFile in collectionSet
Set fileArray(i) = oFile
i = i + 1
Next
For Each oFile In fileArray
' Count lines and rename
Next
It seems that collectionSet is the collection of files in the folder that you are trying to modify. The problem is that with each pass through the for-each loop you are adding files to this folder, some of which are fed back into the loop. What you need to do is the find a way to take a snapshot of the folder before you try to iterate over it. The way to do this would be to replace the folder collectionSet by a collection of strings which are the names of the files before you iterate over it, and modify your code to open the files by their name (instead of via a file object). That way the collection won't be expanding while you iterate over it.
You should create your vars in the scope they are used (e.g. your
file/folder objects are used in the sub.
Always explicit(ly) declare your vars.
You don't need to copy the file and rename it then do the delete.
Just rename it with the FileObject.Name property.
Here is an example:
Option Explicit 'always declare your vars!
Dim strFolder: strFolder = "c:\temp\Rename Test"
Dim strExtension: strExtension = "txt"
' Call Sub to rename the files in the folder
ChangeFileName strFolder, strExtension
Sub ChangeFileName(strFolder, strExtension)
Const ForReading = 1
Dim FSO: set FSO = CreateObject("Scripting.FileSystemObject")
Dim objFolder: set objFolder = FSO.GetFolder(strFolder)
Dim colFiles: set colFiles = objFolder.Files
Dim objFile
Dim intCount
Dim strFileName
Dim objTextStream
For Each objFile In colFiles
msgbox "File: " & objfile.path & vbcrlf & FSO.GetExtensionName(objFile.path)
if UCase(FSO.GetExtensionName(objFile.Path)) = UCase(strExtension) and _
objFile.Size > 0 then
'set LineCnt = FSO.OpenTextFile(objFile, ForReading)
set objTextStream = objFile.OpenAsTextStream(ForReading,-2)
intCount = 0
strFileName = objFile.Name
Do While objTextStream.AtEndOfStream <> True
intCount = intCount + 1
objTextStream.ReadLine
Loop
objTextStream.Close
objFile.Name = FSO.GetBaseName(objFile.Path) & "-" & _
intCount & "." & FSO.GetExtensionName(objFile.Path)
end if
Next
End Sub

List most recent files in ASP Classic

I am redesigning our department website and our IT department does not support the intranet development. The server runs ASP Classic and is able to run VB scripts and Javascript to an extent (somethings work others don't).
So here is my problem:
I modified a simple code that I got from http://www.brainjar.com/asp/dirlist/
to list all the PDF Files in a directory including sub directories but I am not sure how to sort it.
As of now it sorts it in alphabetical order per each folder it reads. I would like it to sort every file of every sub directory by the item.DateLastModified property I do not know if this possible.
I am thinking I would need to store the items in an array and then sort the array and print the data but I have no idea how to do that it has been 10 years since I took a programming course.
Any help would be greatly appreciated!
Current code I am using :
====>
<% sub ListFolderContents(path)
dim fs, folder, file, item, url
set fs = CreateObject("Scripting.FileSystemObject")
set folder = fs.GetFolder(path)
for each item in folder.SubFolders
ListFolderContents(item.Path)
next
'Display a list of files
for each item in folder.Files
url = MapURL(item.path)
if item.type = "PDF File" then
Response.Write("<dt>" & item.Name & "" _
& vbCrLf)
end if
next
Response.Write("</dt>" & vbCrLf)
end sub
function MapURL(path)
dim rootPath, url
'Convert a physical file path to a URL for hypertext links.
rootPath = Server.MapPath("/")
url = Right(path, Len(path) - Len(rootPath))
MapURL = Replace(url, "\", "/")
end function %>
The original is at http://www.brainjar.com/asp/dirlist/
Well, it's your lucky day! I happen to have old code that I wrote for personal use ~10 years ago, so with little tweaking it can fit your case almost perfectly. The key is using a disconnected recordset to hold all the data, then sort by date last modified. The crawling itself is similar to what you already have, by recursion. Note that no need to create new folder instance in each iteration - it's waste of resources, since you already have the folder object in the loop.
Anyway, here it is:
Const adVarChar = 200
Const adInteger = 3
Const adDate = 7
Dim objFSO, oFolder, objRS
Sub ExtractAllFiles(oFolder)
Dim oSubFolder, oFile
'recurse all sub folders
For Each oSubFolder In oFolder.SubFolders
Call ExtractAllFiles(oSubFolder)
Next
'loop through all the files found, add to the recordset
For Each oFile in oFolder.Files
objRS.AddNew
objRS.Fields("Name").Value = oFile.Name
objRS.Fields("Url").Value = MapURL(oFile.Path)
objRS.Fields("Type") = oFile.Type
objRS.Fields("DateLastModified").Value = oFile.DateLastModified
Next
End Sub
Sub ListFolderContents(sPath, sTypeToShow)
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set oFolder = objFSO.GetFolder(sPath)
'create a disconnected recordset
Set objRS = Server.CreateObject("ADODB.Recordset")
'append proper fields
objRS.Fields.Append "Name", adVarChar, 255
objRS.Fields.Append "Url", adVarChar, 255
objRS.Fields.Append "Type", adVarChar, 255
objRS.Fields.Append "DateLastModified", adDate
objRS.Open
'extract all files in given path:
Call ExtractAllFiles(oFolder)
'sort and apply:
If Not(objRS.EOF) Then
objRS.Sort = "DateLastModified DESC"
objRS.MoveFirst
End If
'loop through all the records:
Do Until objRS.EOF
If (Len(sTypeToShow)=0) Or (LCase(sTypeToShow)=LCase(objRS("Type"))) Then
Response.Write("<dt>" & objRS("Name") & " (Type: " & objRS("Type") & ", Last modified: " & objRS("DateLastModified") & ")</dt>" _
& vbCrLf)
End If
objRS.MoveNext()
Loop
'clean up resources
Set oFolder = Nothing
Set objFSO = Nothing
objRS.Close
Set objRS = Nothing
End Sub
To use it in your code, have such line in the HTML body:
<% Call ListFolderContents(Server.MapPath("."), "PDF File") %>
You can of course use different path and change the display to show only what you need.

Script help needed editing ini file

I'm trying to edit one line in an ini file. DeviceName=APPLE to DeviceName="The User Input". I have it almost there from bits and pieces across the internet. It works except the end result is my file jwalk.ini with the correct entry after user input but the ini file has been renamed to just .ini, no jwalk before ini. I must be missing something. The file jwalk.ini already will exist I just need to edit it with the new user input and leave the file named the same.
My Script:
Const ForReading = 1
Const ForWriting = 2
Const OpenAsASCII = 0
Const CreateIfNotExist = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Open existing file for read access.
strInput = "c:\MyFolder\jwalk.ini"
Set objInput = objFSO.OpenTextFile(strInput, ForReading)
' Prompt for device name.
strDeviceName = InputBox("Enter devicename", "JWalk PC Name or Session Name")
' Specify the new file name.
strOutput = "c:\MyFolder\" & strComputer & ".ini"
' Create new file with write access.
Set objOutput = objFSO.OpenTextFile(strOutput, _
ForWriting, CreateIfNotExist, OpenAsASCII)
' Process input file.
Do Until objInput.AtEndOfStream
' Read next line of the input file.
strLine = objInput.ReadLine
' Search for line to be modified.
' Make search case insensitive.
If (InStr(LCase(strLine), "devicename=") > 0) Then
' Replace the line.
' You could also modify the line.
strLine = "devicename=" & strDeviceName
End If
' Write line to the output file.
objOutput.WriteLine strLine
Loop
' Clean up.
objInput.Close
objOutput.Close
' Delete the original file.
objFSO.DeleteFile(strInput)
Any ideas? Thanks.
If you'd have used Option Explicit, you'd have been told that
strOutput = "c:\MyFolder\" & strComputer & ".ini"
uses the undefined/uninitialized variable strComputer.
Here you are passing "strComputer" as a var, but never set it's value:
' Specify the new file name.
strOutput = "c:\MyFolder\" & strComputer & ".ini"
If you are trying to get the computer name you could consider this:
' Specify the new file name.
strOutput = "c:\MyFolder\" & GetComputerName() & ".ini"
Function GetComputerName()
Dim ob
Set ob = Wscript.CreateObject("Wscript.Network")
GetComputerName = ob.ComputerName
Set ob = nothing
End Function

Resources