Make a directory and copy a file - vbscript

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 "

Related

VBS Script that will execute on all subfolders

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

How to rename a file and overwrite existing in VBS?

I already an existing vbs script to take one file (titled "Running_12345.xlsx") from one location and put it in the folder titled "Folder". This is an hourly file that has a long name based on what time it was run.
Now, I want to rename the file just "Running.xlsx" to remove the constantly changing file name. Initially, this code works, but for any subsequent occurence, it fails because the "Running.xlsx" file has already been renamed once and now already exists. How do I add overwrite logic to this code:
dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
set oFldr = fso.getfolder("folder")
for each ofile in oFldr.Files
if lcase(fso.GetExtensionName(ofile.Name)) = "xlsx" then
ofile.name = "Running.xlsx"
Exit for
end if
Next
Duh, just delete the file first. The code below does what I want:
dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
set oFldr = fso.getfolder("C:\Users\...\Desktop\MosaicTransforms\")
fso.DeleteFile("C:\Users\...\Desktop\MosaicTransforms\MosaicFile.xlsx")
for each ofile in oFldr.Files
if lcase(fso.GetExtensionName(ofile.Name)) = "xlsx" then
ofile.name = "MosaicFile.xlsx"
Exit for
end if
Next

Unable to use the values in vbscript (for file copy) fetched from an XML file

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

VBScript to Rename File with Specific Prefix in Folder

I have successfully created a VBScript that renames a file as required when it is the only file in the folder. I cannot figure out how to have the script search past the most recent file.
Option Explicit
Dim fso, folder, file, tmFile
Dim folderName
folderName = "\\pcc\Int\PC\Inbox\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderName)
Set tmFile = Nothing
For each file In folder.Files
If (tmFile is Nothing) Then
Set tmFile = file
Exit For
End IF
Next
If InStr(tmfile.name, "TM") Then
TmFile.Name = Replace(tmFile.Name, ".txt", "A.txt")
End if
The above script correctly renames the file.
Here are a few modifications I have tried to go through all of the files in the folder to search for the file that has the prefix TM. This will always be the only file with the TM prefix.
For Each InStr(tmFile.name, "TM") Then
tmFile.Name = Replace(tmFile.Name, ".txt", "A.txt")
Exit for
and
If tmFile.fileexists(tmFile.name, "TM") Then
tmFile.Name = Replace(tmFile.Name, ".txt", "A.txt")
End if
You are close with your instr(), it's just that you need to put that test within your already existing For loop:
Option Explicit
Dim fso, folder, file, tmFile
Dim folderName
folderName = "\\pcc\Int\PC\Inbox\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderName)
For each file In folder.Files
If instr(file, "TM") > 0 THEN
file.name = replace(file.name, ".txt", "A.txt")
End IF
Next
I've removed the tmfile variable since it's simply not needed here.

copying folder to another path getting error

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

Resources