I am writing a script to determine the combined size of all instances of a particular subfolder within the profile folder of each user who has logged onto a Windows 2003 server, e.g. all users' desktop folders or all users' local settings folders.
Option Explicit
Dim colSubfolders, intCount, intCombinedSize, objFolder2, objFSO1, objFSO2, objUserFolder, strOutput, objSearchFolder, objSubfolder, strSearchFolder, strSubfolderPath
intCount = 0
intCombinedSize = 0
strSearchFolder = "C:\Documents and Settings\"
Set objFSO1 = CreateObject("Scripting.FileSystemObject")
Set objSearchFolder = objFSO1.GetFolder(strSearchFolder)
Set colSubfolders = objSearchFolder.SubFolders
For Each objUserFolder in colSubfolders
strSubfolderPath = objUserFolder.Path & "\Desktop\"
Set objFSO2 = CreateObject("Scripting.FileSystemObject")
Set objSubfolder = objFSO2.GetFolder(strSubfolderPath)
intCount = intCount + 1
intCombinedSize = intCombinedSize + objSubfolder.Size
Next
MsgBox "Combined size of " & CStr(intCount) & " folders: " & CStr(intCombinedSize / 1048576) & " MB"
This code throws a 'Path not found' error (Code 800A004C) at line 15:
Set objSubfolder = objFSO2.GetFolder(strSubfolderPath)
If I print out strSubfolderPath, however, I find that all the strings returned are valid directory paths, so I don't understand why I'm getting this error.
I've tried with and without the trailing backslash at the end of the path and I've tried with 8.3 style paths to remove spaces but to no effect.
When I run your code I get the same error.
Upon further inspection, on my computer there is a folder named C:\Documents and Settings\machinename, where machinename is the name of my computer. This folder only contains one subfolder named ASPNet.
I'm guessing you have something similar.
To minimize multiple-backslash confusion, use the FileSystemObject methods consistently instead of relying on string concatenation:
strSubfolderPath = objFSO1.BuildPath(objUserFolder.Path,"Desktop")
Related
A previous team where I work created a vbs script that can automatically start a restore of a Macrium Image File located on inserted optical media. The problem is that the Macrium Image File is now too big for one disc, and now we have it split onto 2 separate discs, so now the vbs script doesn't function the way it should.
When Automatic Restore is launched, it should detect disc 1, which ends in 00.00.mrimg and know that it is part of a multi-disc install, at which point it asks for the next disc, ending in 00-01.mrimg.
I know this probably makes no sense, especially if anyone reading is not familiar with Macrium. But I will do my best to answer any questions.
I would normally plug away and try to figure it out myself, but i'm not very familiar with VBS and the problem is pretty time sensitive. Any help I can get will be much appreciated.
Opened AutoRestore.vbs script to see if I could fix the issue, but I don't know enough about vbs to fix it.
'AutoRestore.vbs
Dim fso, d, dc, s, n , Root, u, racine, folder, folderName, restoreString, foundFile, cdDrive
Dim wipe
Dim objShell
Set objShell = WScript.CreateObject("WScript.shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set dc = fso.Drives
foundFile = false
restoreString = "00-00.mrimg"
For Each d in dc
Root = d.Driveletter & ":"
racine = d.Driveletter & ":\"
u= Detect(Root)
if (( u="CD-ROM") ) then
cdDrive = cdDrive & racine & " "
if (d.isReady) then
folderName = racine & "IAS\"
Set folder = fso.GetFolder(folderName)
end if
end if
Next
If IsNull(folder) or IsEmpty(folder) Then
MsgBox "Could not locate IAS folder containing restore image." & vbCrLf & "The following optical disk drives were searched: " & cdDrive & vbCrLf & "Please verify the media is the drive or use manual restore.", 48, "Folder Not Found"
Else
For each file in folder.Files
If instr(1,file.Name, restoreString, vbTextCompare) > 0 Then
return = objShell.run("""%ProgramFiles%\macrium\diskrestore.exe""" & folderName & file.Name & " -r -g -u --targetnum 0 --reboot --eject",1,false)
foundFile = true
Exit For
End If
Next
if (foundFile = false) Then
MsgBox "Cannot locate .mrimg file in " & folderName & "." & vbCrLf & "Please use manual restore.", 48, "File Not Found"
End If
End If
Function Detect(DrivePath)
Dim fso, d, s, t
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = fso.GetDrive(fso.GetDriveName(fso.GetAbsolutePathName(DrivePath)))
Select Case d.DriveType
Case 0: t = "Unknown"
Case 1: t = "Removable"
Case 2: t = "Fixed"
Case 3: t = "Network"
Case 4: t = "CD-ROM"
Case 5: t = "RAM Disk"
End Select
Detect = t
End Function
Expected Results: Run AutoRestore.vbs, the script sees the 00-00.mrimg file in IAS folder of the optical media, then prompts to insert the optical media containing the 00-01.mrimg file.
Actual Results: Run AutoRestore.vbs, then Macrium states "Backup set is not complete. At least one file may be missing."
You could first copy all the mrimg files to a temporary folder on the machine's hard drive. Once you have them all, you can then run Disk Restore with that folder instead of the CD-ROM drive.
Most of your existing code would work. After the For Each d in dc loop, you know the drive where the discs are being inserted. You could add another loop:
Dim tempFolder
Set tempFolder = fso.GetFolder("C:\AutoRestore\")
Do While MsgBox("Please insert disc and click OK. When all discs have been inserted, click Cancel", vbOKCancel, "Auto Restore") = vbOK
For Each file In folder.Files
If InStr(1, file.Name, ".mrimg") > 0 Then
' Copy file to Temp folder
fso.CopyFile file.Path, tempFolder.Path & "\", True
End If
Next
Loop
After this, you should have all the mrimg files in the tempFolder location. I am not familiar with the parameters the Marcium command expects but this is where you would specify the new folder:
objShell.run("""%ProgramFiles%\macrium\diskrestore.exe""" & tempFolder.Path & "\" & file.Name & " -r -g -u --targetnum 0 --reboot --eject",1,false)
I am trying to get this script to work, it gets 4 arguments and ends renaming the the folder (FDirectory) removing spaces and starting a batch file with the new arguments. The problem is that it returns an error "access denied" for folders containing read-only files. Is there a way to get this to work? Thanks in advance.
Set WshShell = CreateObject("WScript.Shell")
currentDirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
length = Len(currentDirectory)
State = WScript.Arguments.item(0)
Directory = Left(WScript.Arguments.item(1),length+6)
FDirectory = Replace(WScript.Arguments.item(1)," ",".")
Kind = WScript.Arguments.item(2)
Message = WScript.Arguments.item(3)
'change folder name
If (kind = "multi") And (Directory = currentDirectory & "SFetch") then
Set FS = CreateObject("Scripting.FileSystemObject")
FS.MoveFolder WScript.Arguments.item(1),Replace(WScript.Arguments.item(1)," ",".")
END IF
currentDirectory = currentDirectory & "Rename.bat "
WshShell.RUN currentDirectory & State & " " & Directory & " " & FDirectory & " " & Kind & " " & Message, 0, True
Set WshShell = Nothing
Read-only files don't create an issue - but renaming a folder with open files inside it, or renaming the current working directory will create problems.
I have a question regarding how I should go about fixing an error that I am seeing when running my script. I am pretty sure it has to do with the way in which I am using the %COMPUTERNAME% environment variable.
What my script does is it zips up some files locally, then copies them using robocopy to a mounted or shared drive, then checks to see if the file sizes are the same, and if they are then it deletes the files on the original computer. If any step in the process produces an error it exits the script.
Now the script works perfectly fine if I do not add in the "%COMPUTERNAME%" to the final destination path. (Where the zipped files will eventually be) I need the zipped files to be placed into their own folders with the name of the host from which it originated, because this script will be run on many different machines all going to the same location.
So basically it needs to look something like this:
E:\LocalHostName\TestZip.zip
Now the script will build the folder just fine when the zipped files are being copied over, the problem occurs once the file size check starts. I am getting the error of "File not found" for the line "FileToBeCompared2". I understand why the error is being produced, because it is not recogizing the %COMPUTERNAME% environment variable, but I do not know how to go about addressing this issue.
I am also going to try to add in some functionality where if an error occurs a text file with something like "An error occured during the script" is produced in the output folder.
Thank you for all your help in advance. The script is found below:
'-------------------------------------------------------------------------------------------
'This script is used to zip files locally, copy them to a new location, verify that the
'files were copied correctly, and then delete the files from the original source.
'In it's current state it is being used as a means to zip event files and move them
'to a central location.
'Run with administrator priveleges.
'-----------------------------------------------------------------------------------------------------
Option Explicit
Dim sDirectoryPath, sLocalDestinationPath, sFinalDestinationPath, sOutputFilename, Shell, sFileExt, sFilePrefix
Set Shell = WScript.CreateObject("WScript.Shell")
'Specify Directory Path where files to be zipped are located
'Specify local destination for zipped files
'Specify final destination path for zippped files
'Specify file extension name to look for
'Specify prefix of filename to look for
sDirectoryPath = "C:\Testscripts\"
sLocalDestinationPath = "C:\ScriptOutput\"
sFinalDestinationPath = "E:\CopyTestFolder\" & sOutputFilename & "\"
sFileExt = ".evtx"
sFilePrefix = "Archive*"
sOutputFilename = shell.ExpandEnvironmentStrings("%COMPUTERNAME%") 'Environment variables needed for grabbing hostname
Dim ZipCommand, RobocopyCommand, RunCommand, filesys, filetext
Dim d : d = Date()
Dim dateStr : dateStr = Year(d) & "-" & Right("00" & Month(d), 2) & "-" & Right("00" & Day(d), 2) 'Date String
Dim t : t = Time()
Dim timeStr: timeStr = Hour(t) & "-" & Right("00" & Minute(t), 2) & "-" & Right("00" & Second(t), 2) 'Time String
Dim FullFileName
FullFileName = sOutputFilename & "-" & dateStr & "-" & timeStr & ".zip "
'Following command runs 7-zip and grabs the files to be zipped from your set sDirectoryPath, zips them into set sLocalDestinationPath
'and names the file with the localhost name and date/time
ZipCommand = """C:\Program Files\7-zip\7z.exe"" a " & sLocalDestinationPath & FullFileName & sDirectoryPath & sFilePrefix & sFileExt
RunCommand = Shell.Run(ZipCommand,0,true)
if err.Number <> 0 then
WScript.Echo "An error has occurred during the zip process, re-run Script." WScript.Quit
end if
Wscript.Sleep 2000
'The following command creates a folder named after the host computer where the files are being copied from
Dim newfolder, newfolderpath, filesys2
newfolderpath = "E:\CopyTestFolder\" & sOutputFilename & "\"
set filesys2 = CreateObject("Scripting.FileSystemObject")
If Not filesys2.FolderExists(newfolderpath) Then
Set newfolder = filesys2.CreateFolder(newfolderpath)
End If
'Following command runs Robocopy from command line, moves files from your set sLocalDestinationPath to your set sFinalDestinationPath
WScript.Echo "Robocopy.exe " & sLocalDestinationPath & " " & sFinalDestinationPath
RobocopyCommand = "Robocopy.exe " & sLocalDestinationPath & " " & sFinalDestinationPath
RunCommand = Shell.Run(RobocopyCommand,0,true)
if err.Number <> 0 then
WScript.Echo "An error has occured copying the files, re-run Script."
WScript.Quit
end if
Dim fso, FileToBeCompared1, FileToBeCompared2
Set fso = CreateObject("Scripting.FileSystemObject")
'Setting the Local file to be compared
Set FileToBeCompared1 = fso.GetFile(sLocalDestinationPath & FullFileName)
WScript.echo sFinalDestinationPath & FullFileName
'Setting the file copied to final destination to be compared
Set FileToBeCompared2 = fso.GetFile(sFinalDestinationPath & FullFileName)
If FileToBeCompared1.size = FileToBeCompared2.size then
fso.DeleteFile("C:\Testscripts\Archive*.evtx") 'This will be the path where events are being Archived to. (Non restricted path)
fso.DeleteFolder("C:\ScriptOutput") 'This deletes the archive folder that 7-zip builds each time this script is run
else
WScript.Echo "File sizes do not match, File was not fully copied, Re run script."
WScript.Quit
end if
Because fso.GetFile() will not automatically expand %COMPUTERNAME%, modify sFinalDestinationPath to use sOutputFilename like this:
sOutputFilename = shell.ExpandEnvironmentStrings("%COMPUTERNAME%")
sFinalDestinationPath = "E:\CopyTestFolder\" & sOutputFilename & "\"
I'm making a script to list all files within a folder.
The intention is to list all files within a specific folder on every server we have.
So I have an excel file with as first line every servername.
Of course I don't have rights on every server or there is no scripts folder; so sometimes i get a "path not found" error.
Eventhough I used On Error Resume Next it still throws the error.
I would need something like try - catch, but that doens't exists in vbs.
How can I try to connect to folders and ignore when there's an error?
The offending lines is the Set folder = ...
Do While objSheet.Cells(1, intCol).Value <> ""
intRow = 2
sFolder ="\\" & objSheet.Cells(1, intCol).Value & "\C$\Scripts"
'msgbox sFolder
Set folder = fso.GetFolder(sFolder)
Set files = folder.Files
...
The full code: https://gist.github.com/076501c940e8388b5b39
You can check if a folder exists with fso.FolderExists(sFolder):
If fso.FolderExists(sFolder) then
Set folder = fso.GetFolder(sFolder)
Set files = folder.Files
For each file In files
'msgbox file.name
objSheet.Cells(intRow, intCol).Value = file.Name
introw = introw + 1
Next
objExcel.ActiveWorkbook.Save
intCol = intcol+1
End if
I have a VBScript that checks for the existence of a file in a directory on a remote machine. I am looking to retrieve the "Product Version" for said file (NOT "File Version"), but I can't seem to figure out how to do that in VBScript.
I'm currently using Scripting.FileSystemObject to check for the existence of the file.
Thanks.
I use a function that is slightly modified from the previous example. The function takes the path and file name and returns the "Product Version"
Function GetProductVersion (sFilePath, sProgram)
Dim FSO,objShell, objFolder, objFolderItem, i
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(sFilePath & "\" & sProgram) Then
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(sFilePath)
Set objFolderItem = objFolder.ParseName(sProgram)
Dim arrHeaders(300)
For i = 0 To 300
arrHeaders(i) = objFolder.GetDetailsOf(objFolder.Items, i)
'WScript.Echo i &"- " & arrHeaders(i) & ": " & objFolder.GetDetailsOf(objFolderItem, i)
If lcase(arrHeaders(i))= "product version" Then
GetProductVersion= objFolder.GetDetailsOf(objFolderItem, i)
Exit For
End If
Next
End If
End Function
I've found that the position of the attributes has occasionally changes (not sure why) in XP and Vista so I look for the "product version" attribute and exit the loop once it's found. The commented out line will show all the attributes and a value if available
You can use the Shell.Namespace to get the extended properties on a file, one of which is the Product Version. The GetDetailsOf function should work. You can test with the following code to get an idea:
Dim fillAttributes(300)
Set shell = CreateObject("Shell.Application")
Set folder = shell.Namespace("C:\Windows")
Set file = folder.ParseName("notepad.exe")
For i = 0 to 299
Wscript.Echo i & vbtab & fillAttributes(i) _
& ": " & folder.GetDetailsOf(file, i)
Next
One thing to be aware of:
The extended properties of a file differs between versions of Windows. Hence, the product version index numbers changes based on the version of Windows you are using. You can use the code above to determine what they are. From my testing, I believe they are as follows:
Window XP - 39
Windows Vista - 252
Windows 7 - 268
Windows 2008 R2 SP1 - 271
Windows 2012 R2 - 285
You may also find the following post helpful.
The product version can be retrieved directly with the ExtendedProperty method.
function GetProductVersion(Path)
dim shell, file
set shell = CreateObject("Shell.Application")
const ssfDesktop = 0
set file = shell.Namespace(ssfDesktop).ParseName(Path)
if not (file is nothing) then
GetProductVersion = _
file.ExtendedProperty("System.Software.ProductVersion")
end if
end function
By contrast with a couple of older answers,
This does not require looping over an unknown or arbitrary number of columns with GetDetailsOf.
This uses the canonical name of the property, not the display name. One can also use the FMTID and PID: "{0CEF7D53-FA64-11D1-A203-0000F81FEDEE} 8".
This avoids the need to split the path into directory and name, by starting at the root (desktop) namespace.
' must explicitly declare all variables
Option Explicit
' declare global variables
Dim aFileFullPath, aDetail
' set global variables
aFileFullPath = "C:\Windows\Notepad.exe"
aDetail = "Product Version"
' display a message with file location and file detail
WScript.Echo ("File location: " & vbTab & aFileFullPath & vbNewLine & _
aDetail & ": " & vbTab & fGetFileDetail(aFileFullPath, aDetail))
' make global variable happy. set them free
Set aFileFullPath = Nothing
Set aDetail = Nothing
' get file detail function. created by Stefan Arhip on 20111026 1000
Function fGetFileDetail(aFileFullPath, aDetail)
' declare local variables
Dim pvShell, pvFileSystemObject, pvFolderName, pvFileName, pvFolder, pvFile, i
' set object to work with files
Set pvFileSystemObject = CreateObject("Scripting.FileSystemObject")
' check if aFileFullPath provided exists
If pvFileSystemObject.FileExists(aFileFullPath) Then
' extract only folder & file from aFileFullPath
pvFolderName = pvFileSystemObject.GetFile(aFileFullPath).ParentFolder
pvFileName = pvFileSystemObject.GetFile(aFileFullPath).Name
' set object to work with file details
Set pvShell = CreateObject("Shell.Application")
Set pvFolder = pvShell.Namespace(pvFolderName)
Set pvFile = pvFolder.ParseName(pvFileName)
' in case detail is not detected...
fGetFileDetail = "Detail not detected"
' parse 400 details for given file
For i = 0 To 399
' if desired detail name is found, set function result to detail value
If uCase(pvFolder.GetDetailsOf(pvFolder.Items, i)) = uCase(aDetail) Then
fGetFileDetail = pvFolder.GetDetailsOf(pvFile, i)
End If
Next
' if aFileFullPath provided do not exists
Else
fGetFileDetail = "File not found"
End If
' make local variable happy. set them free
Set pvShell = Nothing
Set pvFileSystemObject = Nothing
Set pvFolderName = Nothing
Set pvFileName = Nothing
Set pvFolder = Nothing
Set pvFile = Nothing
Set i = Nothing
End Function
Wscript.Echo CreateObject("Scripting.FileSystemObject").GetFileVersion("C:\Windows\notepad.exe")