This question already has answers here:
Adding quotes to a string in VBScript
(8 answers)
Closed 5 years ago.
The script below works fine. It searches a specified location for .exe files and outputs a file which contains the location of the files.
All of that works great. Except I'd like the output file lines to all be enclosed in " ", how to do this?
Option Explicit 'force all variables to be declared
On Error Resume Next
Const ForWriting = 2
Dim objFSO
Set objFSO = CreateObject(Scripting.FileSystemObject)
Dim objTS 'Text Stream Object
Set objTS = objFSO.OpenTextFile("output_path", ForWriting, True)
Recurse objFSO.GetFolder("location_of_files")
objTS.Close()
Sub Recurse(objFolder)
Dim objFile, objSubFolder
For Each objFile In objFolder.Files
If LCase(objFSO.GetExtensionName(objFile.Name)) = "exe" Then
objTS.WriteLine(objfile.Path)
End If
Next
For Each objSubFolder In objFolder.SubFolders
Recurse objSubFolder
Next
End Sub
Change this line:
objTS.WriteLine(objfile.Path)
To this:
objTS.WriteLine("""" & objfile.Path & """")
It looks weird because you have to double the embedded quotation marks.
Or instead you can use chr(34), like this:
objTS.WriteLine(chr(34) & objfile.Path & chr(34))
The chr() function converts the specified character code to a character.
Related
I'm trying to get a CSV output for a Blender render job duration estimation. I like to input file time stamps into an Excel, so I wrote below VBScript (it's not 100% ready, but the echo should work). However, it won't iterate beyond the 1000th png file. It ends at file 9999.
Currently I got 35432 png files.
Why won't VBScript go beyond 1000 files?
Option Explicit 'force all variables to be declared
Const ForWriting = 2
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objTS 'Text Stream Object
Set objTS = objFSO.OpenTextFile("C:\tmp\output.txt", ForWriting, True)
Recurse objFSO.GetFolder("C:\tmp")
objTS.Close()
Sub Recurse(objFolder)
Dim objFile, objSubFolder
For Each objFile In objFolder.Files
If LCase(objFSO.GetExtensionName(objFile.Name)) = "png" Then
WScript.Echo objFSO.GetBaseName(objFile.Name) & vbTab & _
CDate(objFile.DateLastModified) & vbTab & _
CDate(objFile.DateCreated)
objTS.WriteLine(objfile.Path)
End If
Next
'unmark to make it recursive
'For Each objSubFolder In objFolder.SubFolders
' Recurse objSubFolder
'Next
End Sub
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."
I am trying to copy file using following script.
Option Explicit
Const ForWriting = 2
Dim objFSO
Dim desfolder
Dim oShell
dim s
desfolder = "D:\Databases"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Recurse objFSO.GetFolder("D:\Databases\Images")
Sub Recurse(objFolder)
Dim objFile, objSubFolder
For Each objFile In objFolder.Files
If LCase(objFSO.GetExtensionName(objFile.Name)) = "tif" Then
s = Right(objFile.Name, 10)
S = Left(s, 1)
If Left(s, 1) = "C" Then
Set oShell = WScript.CreateObject("WScript.Shell")
oShell.Run "xcopy.exe " & objFile & " " & desfolder & " /R /Y", _
0, True
End If
End If
Next
For Each objSubFolder In objFolder.SubFolders
Recurse objSubFolder
Next
End Sub
What I am trying to do is checking files in folders and subfolders. If file is tif then checking weather it contains required letter "C" at specific position. and using xcopy to copy the file.
It works fine but is very slow.
Is there any faster method to do this?
Edit: What I want exactly is to find c*.tif in a folder and its subfolders.
Don't use xcopy then. Doing it your way spawns a new process each time you copy a file. Just use the file object's Copy method and be done with it.
Sub Recurse(objFolder)
Dim objFile, objSubFolder
For Each objFile In objFolder.Files
If LCase(objFSO.GetExtensionName(objFile)) = "tif" Then
If LCase(Left(objFile.Name, 1) = "c" Then
objFile.Copy desfolder & "\"
End If
End If
Next
For Each objSubFolder In objFolder.SubFolders
Recurse objSubFolder
Next
End Sub
Note that your destination path requires a trailing backslash because it's a folder (you'd get a "permission denied" error without it). Otherwise you need to specify the destination path including the filename, e.g. like this:
objFile.Copy objFSO.BuildPath(desfolder, objFile.Name)
I am trying to write a script that will search say C:\ and all of its sub folders for a specific extension and save all of theme to a CSV file. I have tried this but to no avail:
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "C:\"
Set objFolder = objFSO.GetFolder(objStartFolder)
Wscript.Echo objFolder.GetExtensionName("*.txt")
Set colFiles = objFolder.Files
For Each objFile in colFiles
If objFile.Extension = "pfx" Then
Wscript.Echo objFile.Name
End If
Next
Wscript.Echo
ShowSubfolders objFSO.GetFolder(objStartFolder)
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
Wscript.Echo Subfolder.Path
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
Wscript.Echo objFile.Name
Next
Wscript.Echo
ShowSubFolders Subfolder
Next
Set WScript = CreateObject("WScript.Shell")
End Sub
I don't think I am going down the right path here. I am not proficient in the least in vb script it just happens to be the only thing I am allowed to use.
Here you go:
Option Explicit 'force all variables to be declared
Const ForWriting = 2
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objTS 'Text Stream Object
Set objTS = objFSO.OpenTextFile("C:\Output.txt", ForWriting, True)
Recurse objFSO.GetFolder("C:\")
objTS.Close()
Sub Recurse(objFolder)
Dim objFile, objSubFolder
For Each objFile In objFolder.Files
If LCase(objFSO.GetExtensionName(objFile.Name)) = "pfx" Then
objTS.WriteLine(objfile.Path)
End If
Next
For Each objSubFolder In objFolder.SubFolders
Recurse objSubFolder
Next
End Sub
I know this is somewhat late, but that's the hard way to get that list. easiest is to sue the command line:
first identify the file where you want the directories like this:
set FileList="C:\path\path\file.csv"
Second identify the starting directory like this:
set Start="C:\path\path"
Then fill it like this:
for /F "usebackq" %i in (`dir /s/b "%Start%\*.pfx"`) do echo %~pi>>%filelist%
Done and done interactively.
PS - the post took out the backticks. That's the character usually under the tilde and they should enclose the complete directory command. Assuming a replace of ! for the backtick tick, the drectory command shold be !dir/s/b "%Start%\*.pfx"!
Later still but even simpler (and fast :0)):
Open a CMD, CD to the directory in question
DIR /S /A-D /B C:\*.something >> D:\ListOf.Files
I have around 30 subfolders(each folder consists many subfolders) in a folder.I am trying to replace some text form each sql file.I have written some code to this in vbscript and test it with 3-4 subfolders and it was working perfectly.But when i am trying to run it with all the folders, the files are not getting written.
'Root path where all folders and files are present
'Change according to your requirement
strPath="W:\New Folder\Test1"
Set objFso = CreateObject("Scripting.FileSystemObject")
'To access folders
Set objFolder = objFso.GetFolder (strPath)
TraverseFolder (objFso.GetFolder(strPath))
Function TraverseFolder(FolderName)
For Each fld in FolderName.SubFolders
TraverseFolder(fld)
For Each flname in fld.Files
if objFso.GetExtensionName(flname.Path)="sql" then
'msgbox fld.Path & "\" & objFso.GetFileName(flname.Path)
'After commenting whole below section,and running rest of code with
'the above mentioned msgbox every single folder and files are getting
'fetched but when i uncomment below section, only some folders and
'files are getting displayed in msgbox'
Const ForReading = 1
Const ForWriting = 2
Set objFile = objFso.OpenTextFile(fld.Path & "\" & objFso.GetFileName(flname.Path), 1)
strText = objFile.ReadAll
objFile.Close
strText= Replace(strText, "A_", "L_")
strText= Replace(strText, "A", "D")
strText= Replace(strText, "Database\Sy", "Database\SQ")
Set objFile = objFso.OpenTextFile(fld.Path & "\" & objFso.GetFileName(flname.Path), 2)
objFile.WriteLine strText
objFile.Close
End If
Next
Next
End Function
It seems to me that you are not using ForReading and ForWriting constants anyway(in the code you posted). Just delete them.