I need to create A set of empty folders, starting at 10, going to 180. This is the script I'm trying to use, but it just creates 10, and nothing else.
Option Explicit
Dim objFSO, objFolder, strDirectory, i
strDirectory = "\path\to\main\folder"
Set objFSO = CreateObject("Scripting.FileSystemObject")
i = 180
While i < 180
Set objFolder = objFSO.CreateFolder(strDirectory & i)
i = i+1
WScript.Quit
Wend
I'm pretty new to VBScript, so maybe the problem is obvious, but I just don't see it. I also tried using a For loop, but that didn't seem to work at all.
Thanks in advance to anyone who reads this.
I have modified your script as follows:
Option Explicit
Dim objFSO, objFolder, strDirectory, i
strDirectory = "C:\Temp\Test\folder"
Set objFSO = CreateObject("Scripting.FileSystemObject")
i = 10 '' <===== CHANGED!
While i < 180
Set objFolder = objFSO.CreateFolder(strDirectory & i)
i = i+1
''WScript.Quit '' <===== COMMENTED OUT!
Wend
With this script, I managed to create 180 folders.
Related
I want to load all files of a directory into an array with vbscipt/hta in order to sort and "call" them later by index. I've tried something like this, but it's not working:
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFileFolder = "C:\"
Set objFolder = objFSO.GetFolder(objFileFolder)
Set colFiles = objFolder.Files
dim arrFileList()
For Each objFile in colFiles
ReDim Preserve arrFileList(UBound(arrFileList) + 1)
FileList(UBound(arrFileList)) = objFile.Name
Next
I'd be grateful for any help! THX in advance
You need to change two things, please see new code below. Comments in line.
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFileFolder = "C:\"
Set objFolder = objFSO.GetFolder(objFileFolder)
Set colFiles = objFolder.Files
dim arrFileList()
ReDim Preserve arrFileList(0) 'If you wish to use the array UBound later on you must redim this here
For Each objFile in colFiles
ReDim Preserve arrFileList(UBound(arrFileList) + 1)
arrFileList(UBound(arrFileList)) = objFile.Name ' Here you were calling FileList, not arrFileList
Next
You could further tidy / improve this code as arrFileList(0) will have no value upon finishing.
By using .bat and .vbs. How it's possible to print first page from each of 1000 PDFs?
The only working solution, which I found is:
Option Explicit
Const FILE_TO_PRINT = "n:\xxx\xxx\xxx\xxx\xxxx.PDF"
Dim shl
Dim fldr
Dim files,file
Set shl = CreateObject("Shell.Application")
Set fldr = shl.Namespace("n:\HEAT06\BAA Cards\66712\20161103\")
Set files = fldr.Items
For Each file in files
If LCase(file.Path) = LCase(FILE_TO_PRINT) Then
file.InvokeVerbEx("Print")
End If
Next
Set shl = Nothing
Set fldr = Nothing
Set files = Nothing
WScript.Quit
it's does work, BUT it will print whole document, when I need only first page.
Attached a VBS I wrote some years ago that will print the first page of all files you drop on it to the default printer. You may change it to that what you need. If you use it with drag & drop, keep in mind, that you have to drag the marked files from the first or last file in order to get the printouts sorted in the way you marked the files. HTH, Reinhard
'//Print first page of pdfs
set WshShell = CreateObject ("Wscript.Shell")
set fs = CreateObject("Scripting.FileSystemObject")
Set objArgs = WScript.Arguments
if objArgs.Count < 1 then
msgbox("Please drag a file on the script")
WScript.quit
end if
'contact Acrobat
Set gApp = CreateObject("AcroExch.App")
gApp.show 'comment or take out to work in hidden mode
'open via Avdoc and print
for i=0 to objArgs.Count - 1
FileIn = ObjArgs(i)
Set AVDoc = CreateObject("AcroExch.AVDoc")
If AVDoc.Open(FileIn, "") Then
Set PDDoc = AVDoc.GetPDDoc()
Set JSO = PDDoc.GetJSObject
jso.print false, 0, 0, true
gApp.CloseAllDocs
end if
next
gApp.hide : gApp.exit : Quit()
MsgBox "Done!"
Sub Quit
Set JSO = Nothing : Set PDDoc = Nothing : Set gApp =Nothing : Wscript.quit
End Sub
after installing Ghostscript you can use the following code (open a notepad and after saving it change the extension to .bat). You have to place the .bat file in the same folder you have the PDFs you want to print.
The code is (gswin64c.exe may change if you have a newer version of Ghostscript)
for %%I in (*.pdf) do "C:\Program Files\gs\gs9.55.0\bin\gswin64c.exe" -dSAFER -dNOPAUSE -dBATCH -sDEVICE#pdfwrite -sOutputFile#"%%~nI-page1.pdf" -dFirstPage#1 -dLastPage#1 "%%I"
Your question is very old but hopefully this will avoid someone else spending hours like I just did to solve it haha
I have a script already which can perform a saveas routine for file names that begin with certain characters.
This is the script below.
'launch Excel and open file
Const xlExcel8 = 56
Const xlOpenXMLWorkbook = 51
Set fso = CreateObject("Scripting.FileSystemObject")
Set xlObj = CreateObject("Excel.Application")
Set re = New RegExp
re.Pattern = "^ABC.*\.xlsx$"
re.IgnoreCase = True
For Each f In fso.GetFolder("C:\Users\Jimbo\Documents\_ThisWeek").Files
If re.Test(f.Name) Then
Set xlFile = xlObj.WorkBooks.Open(f.Path)
xlObj.DisplayAlerts = False
xlfile.SaveAs "C:\Users\Jimbo\Documents\_ThisWeek\Weekly Feed File.xls", xlExcel8
xlFile.Close True
End If
xlObj.DisplayAlerts = True
Next
Set re = New RegExp
re.Pattern = "^ABC.*\.xlsx$"
re.IgnoreCase = True
For Each f In fso.GetFolder("C:\Users\Jimbo\Documents\_ThisWeek").Files
If re.Test(f.Name) Then
fso.Deletefile(f.Path)
End If
Next
xlObj.Quit
Can anyone pls assist with updating the script to rename a file instead of performing a saveas?
This is an extremely simple example.
I don't have enough to go on for how you want to rename the file so you need to fill in that logic. I just defined a variable strName that holds a string value for an example.
You would want to set strName inside the If statement to something that works for you and changes on each loop.
If the path or name will be complex, make sure you double quote the variable.
'rename files from one folder to another
option explicit
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim strPath: strPath = "C:\Users\Jimbo\Documents\_AnotherFolder\"
Dim strName: strName = "SetYourNameHere.xls"
Dim re: Set re = New RegExp
Dim oFile
re.Pattern = "^ABC.*\.xlsx$"
re.IgnoreCase = True
For Each oFile In fso.GetFolder("C:\Users\Jimbo\Documents\_ThisWeek").Files
If re.Test(oFile.Name) Then
oFile.move strPath
oFile.name = strName
End If
Next
You already have the file object. Just move it with it's own method to your other folder then use it's name property to set the value to what you want the name to be.
You should add verification that the file doesn't already exist in the folder and handle that situation gracefully.
You can rename a file by using the MoveFile Method
Dim Fso
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Fso.MoveFile "Test.txt", "Test2.txt"
New at VbScript so please include all lines if you can.
I have
Source-folder C:\s\ with files with names et_v01.txt, et_v02.txt etc. Destination-folder C:\d\ I only want the latest file to be COPIED from S to D which would be et_v02 since we'll use DateLastModified.
Bonus at destination only keep the latest file if it runs next time when a new version comes in. Thanks in advance and I have searched for this but the others had less than criteria and etc.
Option Explicit
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objSTR, objEND, objTYP, objEXT, objKEY, objFILE
Dim Folder, SubFolder
objSTR = "C:\s\"
objEND = "C:\d\"
For Each objFILE in objFSO.GetFolder(objSTR).Files
If objFILE.DateLastModified > DateAdd("d",-4,now) then
objFILE.Copy objEND
End If
Next
Here try this version:
Option Explicit
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strSource, strDestination
strSource = "C:\s\"
strDestination = "C:\d\"
Dim objFile, objOldestFileSoFar
For Each objFile in objFSO.GetFolder(strSource).Files
If Not IsEmpty(objOldestFileSoFar) Then
If objFile.DateLastModified > objOldestFileSoFar.DateLastModified Then
Set objOldestFileSoFar = objFile
End If
Else 'This is the first loop, i.e. we have no previous "last mod" to compare against.
Set objOldestFileSoFar = objFile
End If
Next
objOldestFileSoFar.Copy strDestination
Also, I've cleaned up your code a bit to get rid of unused declarations and to apply better naming to your variables. Take those as suggestions if you like, but just keep in mind that adhering to conventions is important.
I'm looking to use a script to go about disabling a file (REAgentc.exe) on Windows 7 machines and if it does not exist (i.e. on XP machines) then end. Below is what I've got so far but can anyone assist me in implementing the rest of what I'm after? My knowledge on VB script is admittedly not great but any help that can be offered forward would be greatly appreciated, thanks.
'Declare Variables
Dim strApp
Dim arrPath
Dim strPath
Dim strAppPath
' main if statement to run the script and call functions and sub's
If (CheckRegistryForValue)= True Then
'msgbox( strPath & " I am here")
WScript.Quit (0)
Else
RunCommand
WriteRegkey
WScript.Quit (0)
End If
'Sub to run the REAgent disable command
Sub RunCommand
Set objShell = CreateObject("Wscript.Shell")
strApp = "C:\Windows\System32\REAgentc.exe /disable"
arrPath = Split(strApp, "\")
For i = 0 To Ubound(arrPath) - 1
strAppPath = strAppPath & arrPath(i) & "\"
Next
objShell.CurrentDirectory = strAppPath
objShell.Run(strApp)
End Sub
'Function to check registry for value, Return check registry for value
Function CheckRegistryForValue
Set WshShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
dong = wshShell.RegRead ("HKLM\SOFTWARE\REAgent\")
If (Err.Number <> 0) Then
CheckRegistryForValue = False
Else
CheckRegistryForValue = True
End If
End Function
' sub to write registery key to flag computers that the script has run On
Sub WriteRegkey
HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set ObjRegistry = GetObject("winmgmts:{impersonationLevel = impersonate}!\\" & strComputer & "\root\default:StdRegProv")
strPath = "SOFTWARE\REAgent\Script Complete"
Return = objRegistry.CreateKey(HKEY_LOCAL_MACHINE, strPath)
End Sub
You can modify your RunCommand to detect & run;
dim FSO, objShell, strApp
set FSO = CreateObject("Scripting.FileSystemObject")
set objShell = CreateObject("Wscript.Shell")
'//get system path
strApp = FSO.GetSpecialFolder(1) & "\REAgentc.exe"
if FSO.FileExists(strApp) then
'//no need to change directory as you have the full path
objShell.Run(strApp & " /disable")
else
'//does not exist
end if