I have this below code which is copying files from one folder and creating a new folder if does not exist and then pasting the files over there.I am getting a path not found error..meaning if I want to create a new folder in c:\versions\myfolder it is not creating the path and throwing error..am I doing something wrong here.
Dim LastMonth
Dim strFolder
Const strFile = "C:\inetpub\wwwroot\Shared"
Const Overwrite = True
Dim oFSO
LastMonth = DateAdd("m",-1,Date)
strFolder = "C:\Versions\" & "Common_" & Replace(LastMonth,"/","-")&"/"
Set oFSO = CreateObject("Scripting.FileSystemObject")
WScript.Echo strFolder
If Not oFSO.FolderExists(strFolder) Then
oFSO.CreateFolder strFolder
End If
oFSO.CopyFolder strFile, strFolder, Overwrite
To make the question easy to understand I also tried doing this oFSO.CreateFolder("C:\Versions\Shared") but it doe snot work.
You can create folders including their parent folders by recursively traversing the path upwards until you find an existing parent folder, and then create the child folders as you descend back:
Set fso = CreateObject("Scripting.FileSystemObject")
Sub CreateSubFolder(path)
If Not fso.FolderExists(path) Then
drive = fso.GetDriveName(path)
If Not fso.DriveExists(drive) Then
WScript.Echo "Drive " & drive & " doesn't exist."
WScript.Quit 1
End If
parent = fso.GetParentFolderName(path)
If Not fso.FolderExists(parent) Then CreateSubFolder parent
fso.CreateFolder path
End If
End Sub
CreateSubFolder "C:\path\to\some\distant\sub\folder"
You can't create a folder and subfolder at the same time, the parent folder must exists before you can create the sub-folder.
You put a forward slash (/) in the folder name instead of a backslash (\) in the strFolder path. (Typo?!)
Hope that helps
Related
Update-----
My vbs script should take camera photos and rename them from a unique name like "0634_IMG" to a recursive number from 01 to 100. For example say there are 3 photos in the folder: 001_IMG, 003_IMG, and 006_IMG my script should rename these files to 01, 02, and 03 respectively.
I have a version that works when I drag and drop the script into the specific folder, but there are 1000's of folders so I want to be able to place it into the parent folder and it execute on all subfolders.
So it should be a folder drill down that only looks for files with the extension GIF, IMG, and PNG.
Folder Structure: Location>Block#>Letter(comprised of 3 folders A, B, and C)>Chamber(for each letter there are 4 subfolders)>Pictures (each subfolder has the pictures I am trying to rename)
so to review, I want to be able to put the script in the same folder as the block# and it execute on the pictures in the last folder for every subfolder. So after I run the script each picture should be renamed 01-100 and maintain its position within the folder scheme.
Thanks to the help of CHNguyen, my code was edited so that it would maintain the folder structure I describe above.
The issue now is that the script is numbering the pictures in every folder continuously and does not start or restart at 1.... For example after executing the script, Folder 1 (which contains 30 images) is outputting file names 830-860, when it should be 1-30. Additionally, the other subfolders have this same issue and it seems that the count or "intFileParts" is not being reset and I can't get it to reset.
I ask the coding gods for help as I am a newb and thanks in advance.
Option Explicit
Dim fso
Dim oFolder, oSubFolder
Dim oFile
Dim sPath, strOldName, strNewName
Dim intFileParts
' Create the instance of the fso.
Set fso = CreateObject("Scripting.FileSystemObject")
' Set the folder you want to search.
sPath = fso.GetFolder(fso.GetAbsolutePathName(".")) + "\"
RenameFiles(sPath)
Sub RenameFiles(Path)
Set oFolder = fso.GetFolder(Path)
intFileParts = 1 ' Restart at 1
' Loop through each file in the folder.
For Each oFile In oFolder.Files
' Only select images
Select Case oFile.Type
Case "GIF Image", "JPG Image", "PNG Image"
End Select
' Get complete file name with path.
strOldName = oFile.Path
' Build the new file name.
strNewName = ""
strNewName = fso.GetParentFolderName(oFile) & "\" & Right("000" & fso.GetBaseName(oFile), 3) & "." & fso.GetExtensionName(oFile)
' Use the MoveFile method to rename the file.
fso.MoveFile strOldName, strNewName
intFileParts = intFileParts + 1
Next
For Each oSubFolder In oFolder.Subfolders
RenameFiles(oSubFolder.Path)
Next
End Sub
Set oFile = Nothing
Set oSubFolder = Nothing
Set oFolder = Nothing
Set fso = Nothing
This should do:
I reworked the ' Build the new file name. section to properly get the file's parent folder using fso.GetParentFolderName() to "maintain its position within the folder scheme". The padding and incrementing of the numeric value in the filename was also improved/simplified using VB and fso methods.
The "missing" code under ' Use the MoveFile method to rename the file. was also added to perform the rename via fso.MoveFile()
Code:
Option Explicit
Dim fso
Dim oFolder, oSubFolder
Dim oFile
Dim sPath, strOldName, strNewName
Dim intFileParts
' Create the instance of the fso.
Set fso = CreateObject("Scripting.FileSystemObject")
' Set the folder you want to search.
sPath = fso.GetFolder(fso.GetAbsolutePathName(".")) + "\"
RenameFiles(sPath)
Sub RenameFiles(Path)
Set oFolder = fso.GetFolder(Path)
intFileParts = 1 ' Restart at 1
' Loop through each file in the folder.
For Each oFile In oFolder.Files
' Only select images
Select Case oFile.Type
Case "GIF Image", "JPG Image", "PNG Image"
End Select
' Get complete file name with path.
strOldName = oFile.Path
' Build the new file name.
strNewName = ""
strNewName = fso.GetParentFolderName(oFile) & "\" & Right("000" & intFileParts, 3) & "." & fso.GetExtensionName(oFile)
' Use the MoveFile method to rename the file.
fso.MoveFile(strOldName, strNewName)
intFileParts = intFileParts + 1
Next
For Each oSubFolder In oFolder.Subfolders
RenameFiles(oSubFolder.Path)
Next
End Sub
Set oFile = Nothing
Set oSubFolder = Nothing
Set oFolder = Nothing
Set fso = Nothing
What we are trying to achieve: To read directory paths from an XML file and perform a copy and paste operation. The script works if we remove the last line: fso.CopyFolder Directory, t. But it fails when we keep this line. The script is able to read the values from the XML file.
Error occurs at line no: 19
i.e.: For each child in objRoot.childNodes, saying “Object Required”
Option Explicit
set fso = CreateObject("Scripting.FileSystemObject")
dim fso, objDoc, objRoot, child, s, t, WshShell, filesys, ObjShell,objDox
Set objDoc = CreateObject("MSXML.DOMDocument")
objDoc.Async = False
objDoc.Load "location.xml"
objDoc.validateOnParse=False
Set objRoot = objDoc.documentElement
Dim CurrentDirectory, Directory
CurrentDirectory = fso.GetAbsolutePathName(".")
For Each child in objRoot.childNodes
s = child.getAttribute("Source")
t = child.getAttribute("Destination")
Directory = CurrentDirectory & "\" & s
Next
fso.CopyFolder Directory, t
Try Changing
fso.CopyFolder Directory, t
to
fso.CopyFolder Directory, t & "\"
because when copying or moving to a folder you have to end the destination folder with a "\"
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
There are 2 shared drives. One of them has a very complex folder structure. I would like to replicate the entire folder structure of Share 1 to Share 2. However I don't want to make duplicate files, rather I would want a shortcut or symbolic links to be present in the 2nd share. I tried to do this with existing tools like Robocopy and mklink and failed to achieve the result. Any Ideas to resolve this issue is highly appreciated.
You can do achieve this by Using the filesystemobject to work it's way down the folder structure, if the folder exists in the destination, do nothing and create shortcuts in that folder for all the hosting folders files. Otherwise, create the folder and create the shortcuts for the hosting files anyway.
The DoFolder sub widdles it's way down through all the subfolders.
The GetFN Function collects only the filenames of all the files in the hosting folder. Even if there are periods in the filename.
This was a fun program to write, thanks.
FolderShadows.vbs
Dim fso, HostFolder, DestFolder
'Host Folder - Folder must exist.
HostFolder = "C:\From\Folder"
'Destination Folder - Folder must exist.
DestFolder = "D:\To\Folder"
Set fso = CreateObject("Scripting.FileSystemObject")
DoFolder fso.GetFolder(HostFolder)
Sub DoFolder(Folder)
Dim SubFolder
If fso.folderexists(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder)) = False Then
fso.createfolder(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder))
End If
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
Dim FileName, shortcut
If (fso.fileexists(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder) & "\" & GetFN(File.Name) & ".lnk") = False) Then
FileName = Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder) & "\" & GetFN(File.Name) & ".lnk"
Set shortcut = CreateObject("WScript.Shell").CreateShortcut(FileName)
shortcut.Description = "Shortcut To " & File.Name
shortcut.TargetPath = fso.GetAbsolutePathName(Folder) & "\" & File.Name
shortcut.Save
End If
Next
End Sub
Function GetFN(FileName)
Dim Result, i
Result = FileName
i = InStrRev(FileName, ".")
If ( i > 0 ) Then
Result = Mid(FileName, 1, i - 1)
End If
GetFN = Result
End Function
Note: This script can run on an automated schedule, as it is built to auto update the shortcuts and folders if new files/folders are found.
In VBS how do you make a directory and then copy a file into it?
Id like to make a folder in the root of C e.g. C:\folder and then copy a file from \server\folder\file.ext into that new folder
Use the FileSystemObject object, namely, its CreateFolder and CopyFile methods. Basically, this is what your script will look like:
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Create a new folder
oFSO.CreateFolder "C:\MyFolder"
' Copy a file into the new folder
' Note that the destination folder path must end with a path separator (\)
oFSO.CopyFile "\\server\folder\file.ext", "C:\MyFolder\"
You may also want to add additional logic, like checking whether the folder you want to create already exists (because CreateFolder raises an error in this case) or specifying whether or not to overwrite the file being copied. So, you can end up with this:
Const strFolder = "C:\MyFolder\", strFile = "\\server\folder\file.ext"
Const Overwrite = True
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(strFolder) Then
oFSO.CreateFolder strFolder
End If
oFSO.CopyFile strFile, strFolder, Overwrite
You can use the shell for this purpose.
Set shl = CreateObject("WScript.Shell")
shl.Run "cmd mkdir YourDir" & copy "