Error with Loop and recursive function - vbscript

I am trying to create a VbScript file that will read a text file that has a list of folder names in it.
From these folder names I need to create a second text file that prints out all the files with a specific extension.
I have used this code to do the second part of the task
Option Explicit 'force all variables to be declared
Const ForWriting = 2
Dim objFSO 'File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objTS 'Text Stream Object
Set objTS = objFSO.OpenTextFile("C:\Output.txt", ForWriting, True)
Call Recurse("C:\")
objTS.Close()
Sub Recurse(strFolderPath)
Dim objFolder
Set objFolder = objFSO.GetFolder(strFolderPath)
Dim objFile
Dim objSubFolder
For Each objFile In objFolder.Files
'only proceed if there is an extension on the file.
If (InStr(objFile.Name, ".") > 0) Then
'If the file's extension is "pfx", write the path to the output file.
If (LCase(Mid(objFile.Name, InStrRev(objFile.Name, "."))) = ".exe") Then _
objTS.WriteLine(objfile.Path)
End If
Next
For Each objSubFolder In objFolder.SubFolders
Call Recurse(objSubFolder.Path)
Next
End Sub
I have tried to put this in a loop but when I do I get a syntax error for this line Sub Recurse(strFolderPath)
Any help you can give me would be appreciated

One interpretation of
I have tried to put this in a loop but when I do I get a syntax error
for this line Sub Recurse(strFolderPath)
is that the structure of your resulting script looks like:
Do Until tsIn.AtEndOfStream
p = tsIn.ReadLine
Sub Recurse(p)
End Sub
Call Recurse(p)
Loop
output:
cscript 27537600-B.vbs
..\27537600-B.vbs(3, 4) Microsoft VBScript compilation error: Syntax error
VBScript does not allow nested Sub/Function definitions, especially in loops (you may get away with mixing simple statements and Sub/Function definitions in top-level code, but that's more a bug than a feature). If you re-structure the script like
Do Until tsIn.AtEndOfStream
p = tsIn.ReadLine
Call Recurse(p)
Loop
Sub Recurse(p)
End Sub
you won't get a syntax error on the Sub line.

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."

If FileExists delete another file

I am trying to add a sub-routine to a VBScript. In short, I am trying to see if one type of file exists, it will delete another file.
There will be files like:
SOCAL_CU59_res.dxf
SOCAL_CU59_main.dxf
SOCAL_CU59_mot.dxf
SOCAL_CU59_motl.dxf
but on occassion there may be a file with an "x" at the end of the filename:
SOCAL_CU59_resx.dxf
SOCAL_CU59_mainx.dxf
SOCAL_CU59_motx.dxf
SOCAL_CU59_motlx.dxf
They would all be in the same folder. The "x" file has priority. So if it exist I want to delete the matching file file without the "x".
Here is what I have so far but errors. The check filesize routine I added works great but it's after that I am having no luck:
Dim oFSO, sDirectoryPath, oFOLDER, oFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
sDirectoryPath = "S:\SOCAL\Section_11\Road DXFs\"
RecurseFolders sDirectoryPath
Sub RecurseFolders(sFolder)
'Here we set the oFolder object, note that its variable scope is within
'this sub, so you can set it many times and it's value will only be
'that of the sub that's currently running.
Set oFolder = oFSO.GetFolder(sFolder)
'Here we are looping through every file in the directory path.
For Each oFile In oFolder.Files
'This just checks for a file size less than 100Kb
If oFile.Size <= 1085 And Right(LCase(oFile.Name),3) = "dxf" Then
oFile.Delete True
End If
Next
For Each oFile In oFolder.Files
'This checks if there is a file with an 'x' at the end of filename
If FileExists (Right(oFile.Name),1) = "x" Then
oFile.Delete True
End If
Next
'Here we do the recursive bit. We need to loop through each folder in
'the directory too and call the same sub to ensure we check every folder
'in the path.
For Each oFolder In oFolder.SubFolders
RecurseFolders oFolder.Path
Next
End Sub
The script creates both files, but does not delete the file that does NOT have the "x". The error says for line 204, Char 5:
Wrong number of arguments or invalid property assignment: 'Right'
The line the error refers to is: If FileExists (Right(oFile.Name),1) = "x" Then.
You have a few inherent problems that you need to correct in order to do this properly. First, you need to make the parenthesis correction mentioned by Ansgar Wiechers. Second, you should remove the duplicate loop. There's no need to loop over all of the files multiple times. Finally, you should store the files to be deleted until after the loop has finished. Deleting a file while it is in the file set that is currently being looped over could produce unexpected results or unexplained errors.
With that said, here's how I would approach this. You'll note all of the corrections I've mentioned.
Dim oFSO, sDirectoryPath, oFOLDER, oFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
sDirectoryPath = "S:\SOCAL\Section_11\Road DXFs\"
Dim arrFilesToDelete() 'an empty dynamic array to hold files to be deleted later
Dim i = 0 'an iterator used to track the array pointer
RecurseFolders sDirectoryPath
DeleteExtraFiles arrFilesToDelete
Sub RecurseFolders(sFolder)
'Here we set the oFolder object, note that its variable scope is within
'this sub, so you can set it many times and it's value will only be
'that of the sub that's currently running.
Set oFolder = oFSO.GetFolder(sFolder)
'Here we are looping through every file in the directory path.
For Each oFile In oFolder.Files
'Is the file a "dxf" file
If LCase(Right(oFile.Name)) = "dxf" Then
'This just checks for a file size less than 100Kb
If oFile.Size <= 1085 And Right(LCase(oFile.Name),3) = "dxf" Then
End If
'This checks if there is an 'x' at the end of filename
If LCase(Right(oFile.Name) 5) = "x.dxf" Then
'if so, store its counterpart for deletion later
sBadFile = Replace(oFile.Name, "x.dxf", ".dxf")
ReDim Preserve arrFilesToDelete(i)
arrFilesToDelete(i) = oFile.Path & "\" & sBadFile
i = i + 1
End If
End If
Next
'Here we do the recursive bit. We need to loop through each folder in
'the directory too and call the same sub to ensure we check every folder
'in the path.
For Each oFolder In oFolder.SubFolders
RecurseFolders oFolder.Path
Next
End Sub
Sub DeleteExtraFiles(arrFiles)
For Each sFile in arrFiles
If oFSO.FileExists(sFile) Then
oFSO.DeleteFile sFile
End If
Next
End Sub
You put the inner closing parenthesis in the wrong place. The parameter 1 belongs to the function Right. Change this:
If FileExists (Right(oFile.Name),1) = "x" Then
into this:
If FileExists (Right(oFile.Name,1)) = "x" Then
With that said, there might be other issues with that line. VBScript doesn't have a built-in function FileExists and your code snippet doesn't reveal if that function is implemented elsewhere in your code, so whether passing it a character and comparing its return value to the character x actually makes sense is hard to say.
If you meant to use the FileSystemObject method FileExists you'd need to call it from the actual FileSystemObject instance:
If oFSO.FileExists(...) Then
and pass it a filename or path, not a single character or a boolean value.
If you want to test if for any given file foo.ext another file foox.ext exists, and in that case delete foo.ext you'd do something like this:
For Each oFile In oFolder.Files
xFilename = oFSO.GetBaseName(oFile) & "x." & oFSO.GetExtensionName(oFile)
If oFSO.FileExists(oFSO.BuildPath(oFile.Parent, xFilename)) Then
oFile.Delete True
End If
Next

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

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

VBS to Search for Multiple Files Recursively in C:\Users

I need to recursively search for multiple files through the C:\Users directory tree recursively.
If I find any of the specified files in any of the sub-directories, I want to echo out the full path.
Here is what I have:
Dim fso,folder,files,sFolder,newFolder
Dim arr1
arr1 = Array("myFile1.pdf","myFile2.pdf","myFile3.pdf","nutbag.rtf","whoa.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = "C:\Users"
Set folder = fso.GetFolder(sFolder)
Set files = folder.SubFolders
For each folderIdx In files
IF (Instr(folderIdx.Name,"Default") <> 1) Then
If (Instr(folderIdx.Name,"All Users") <> 1) Then
newFolder = sfolder & "\" & folderIdx.Name
CopyUpdater fso.GetFolder(newFolder)
End If
End If
Next
Sub CopyUpdater(fldr)
For Each f In fldr.Files
For Each i in arr1
If LCase(f.Name) = i Then
WScript.echo(f.name)
End If
Next
Next
For Each sf In fldr.SubFolders
CopyUpdater sf
Next
End Sub
If I run it as 'Administrator', I get:
VBScript runtime error: Permission Denied
If I run it as 'Local System' user, I get:
VBScript runtime error: Path not found
If I add, 'On Error Resume Next' to the beginning to suppress the errors, I get nothing back.
I have placed a text file called 'whoa.txt' in numerous locations around the C:\Users sub-dirs.
My suspicion is that it is a Windows permissions thing, but I am unsure.
Thanks much.
First I didn't use your code, it confuses me what you are trying to accomplish.
Next you should run the script in Administrator mode command prompt. This should allow you to check if the file is there.
Then paste code below to a vbs file and cscript it. This code displays all the matched filenames.My idea is that instead of going through all files in any folder for a matching filename, check if those wanted files exists in that folder - this is generally faster as some folders contains hundreds of files if not thousands (check your Temp folder!).
Option Explicit
Const sRootFolder = "C:\Users"
Dim fso
Dim arr1
Dim oDict ' Key: Full filename, Item: Filename
Main
Sub Main
arr1 = Array("myFile1.pdf", "myFile2.pdf", "myFile3.pdf", "nutbag.rtf", "whoa.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
Set oDict = CreateObject("Scripting.Dictionary")
' Call Recursive Sub
FindWantedFiles(sRootFolder)
' Display All Findings from Dictionary object
DisplayFindings
Set fso = Nothing
Set oDict = Nothing
End Sub
Sub FindWantedFiles(sFolder)
On Error Resume Next
Dim oFDR, oItem
' Check if wanted files are in this folder
For Each oItem In arr1
If fso.FileExists(sFolder & "\" & oItem) Then
oDict.Add sFolder & "\" & oItem, oItem
End If
Next
' Recurse into it's sub folders
For Each oFDR In fso.GetFolder(sFolder).SubFolders
FindWantedFiles oFDR.Path
Next
End Sub
Sub DisplayFindings()
Dim oKeys, oKey
oKeys = oDict.Keys
For Each oKey In oKeys
wscript.echo oKey
Next
End Sub

Resources