I require a VBScript that renames a file and then moves it from one folder to another. The script currently renames the file correctly, but I cannot figure out how to move the file to the new folder after the renaming.
Below is the script as it exists.
Option Explicit
Const SAVE_LOCATION = "\\pccit2\Int\PC\Inbox"
Const strPath = "D:\Files\pak\VP\"
Const StrPrefix = "VP"
Dim FSO
Dim FLD
Dim fil
Dim strOldName
Dim strNewName
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FLD = FSO.GetFolder(strPath)
For Each fil In FLD.Files
strOldName = fil.Path
strNewName = strPath & strPrefix & Right(strOldName, 10)
FSO.MoveFile strOldName, strNewName
Next
For Each fil In FLD.Files
If strNewName = 1 Then
FSO.MoveFile "\\pccit2\Int\PC\Inbox"
End If
Next
Set FLD = Nothing
Set FSO = Nothing
I have tried a variety ways of getting the file to move. Here are some other attempts:
If FSO.FileExists("D:\Files\pak\VP\*.*") Then
FSO.MoveFile "D:\Files\pak\VP\*.*", "\\pccit2\Int\PC\Inbox\*.*"
End If
Another attempt
If fil.FileExists("D:\Files\pak\VP\*.*") Then
fil.MoveFile "D:\Files\pak\VP\*.*" , "\\pccit2\Int\PC\Inbox\*.*"
End If
MoveFile is a method of the FileSystemObject object. It expects at least 2 arguments (source and destination), and wildcards can only be used in the source path, not in the destination path. The destination must be a file or folder path (with a trailing backslash if it's a folder). The respective method of file objects is Move, which can be called with just one argument (the destination path). Also, you can move and rename a file in one step. Just specify the destination path with the new file name.
For Each fil In FLD.Files
strNewName = FSO.BuildPath(SAVE_LOCATION, strPrefix & Right(fil.Name, 10))
fil.Move strNewName
Next
If you want to separate renaming from moving you can rename the file by simply changing its name:
For Each fil In FLD.Files
fil.Name = strPrefix & Right(fil.Name, 10)
fil.Move SAVE_LOCATION & "\"
Next
Use this
dim fs
set fs=Server.CreateObject("Scripting.FileSystemObject")
fs.MoveFile "c:\myfolder\*.*","c:\anotherfolder\"
set fs=nothing
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
I need to rename multiple files via VBScript in a particular folder
Example:
Change name to specific name with number convention such as Change Part1.csv to 31-AUG-20-1.csv and Part2.csv to 31-Aug-29-2.csv
Here 31-Aug-20 will remain same but with a incremental number. Therefore in below code i don't want to give new name i.e. 31-Aug-20-1.csv against each file rather it should change to 31-Aug-20(incremental numbering)
Dim fso, folder, file, folderName, dict
'Path
folderName = "C:\User\desktop\ATL\"
'Future FileName
Set dict = CreateObject("Scripting.Dictionary")
dict.Add "Part1.csv", "ATL-31-Aug-20-1.csv"
dict.Add "Part2.csv", "ATL-31-Aug-20-2.csv"
dict.Add "Part3.csv", "ATL-31-Aug-20-3.csv"
dict.Add "Part4.csv", "ATL-31-Aug-20-4.csv"
dict.Add "Part5.csv", "ATL-31-Aug-20-5.csv"
dict.Add "Part6.csv", "ATL-31-Aug-20-6.csv"
' Create filesystem object and the folder object
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderName)
' Loop over all files in the folder until the searchFileName is found
For Each file In folder.Files
If dict.Exists(file.Name) Then file.Name = dict(file.Name)
Next
This code will rename the files with incremental numbering:
Dim iCounter
Dim folderName
Dim fso, folder, file
' Path
folderName = "C:\User\desktop\ATL\"
' Create filesystem object and the folder object
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderName)
iCounter = 1
For Each file In folder.Files
file.Name = "ATL-32-Aug-20-" & iCounter & ".csv"
iCounter = iCounter + 1
Next
If you want to keep the number from the original file name (Part#.csv), you can add the following logic:
Const vbTextCompare = 1
Dim folderName
Dim fso, folder, file
Dim sNumber
Dim sPrefix
' Path and prefix
folderName = "C:\User\desktop\ATL\"
sPrefix = "ATL-32-Aug-20-"
' Create filesystem object and the folder object
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderName)
For Each file In folder.Files
' Check for "Part" and ".csv" in file name
If StrComp(Left(file.Name, 4), "Part", vbTextCompare) = 0 And StrComp(Right(file.Name, 4), ".csv", vbTextCompare) = 0 Then
' Extract number
sNumber = Mid(file.Name, 5, Len(file.Name) - 8)
' Rename file
file.Name = sPrefix & sNumber & ".csv"
End If
Next
I'm getting "Object required" runtime error when trying to run the following code. I am trying to find the most recent file saved in a folder and copy/rename it to another file name. My issue is the If statement to "Check for most recent file in folder" is returning Object errors.
I have followed other suggestions on here, but I can't seem to get over the Object error hurdles. If anyone can provide help for this newbie, I would appreciate it.
Option Explicit
Dim FSO, FSO2, FLD, FIL
Dim strFolder, strContent, strPath, tmpName, tmpName2, mostRecent, newfile
strFolder = "C:\Users\username\Documents\Mockup"
'Create the filesystem object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSO2 = CreateObject("Scripting.FileSystemObject")
'loop through the folder and get the files
For Each FLD in FSO.GetFolder(strFolder).SubFolders
'Reset mostRecent to nothing
Set mostRecent = Nothing
Set mostRecent = CreateObject("Scripting.FileSystemObject")
For Each Fil In FLD.Files
If Fil = FLD & "\import.ARCHIVE" Then
FSO2.DeleteFile FLD & "\import.ARCHIVE"
Fil = FLD & "\import.tra"
End If
If Fil = FLD & "\import.tra" Then
tmpName = Replace(Fil, "import.tra", "import.ARCHIVE")'Replace(String, thisString, toThisString)
'Name Fil as tmpName
FSO.MoveFile Fil, tmpName
End If
'Check for most recent file in folder
If mostRecent Is Nothing Then
Set mostRecent = Fil
ElseIf Fil.DateCreated > mostRecent.DateCreated Then
Set mostRecent = Fil
End If
tmpName2 = Replace(mostRecent, "*.*", "import.tra")'Replace(String, thisString, toThisString)
FSO2.CopyFile mostRecent, tmpName2
Next
Next
'Clean up
Set FLD = Nothing
Set FSO = Nothing
Set FSO2 = Nothing
Set mostRecent = Nothing
just mask Set mostRecent = CreateObject("Scripting.FileSystemObject") will do.
We don't need a File System Object to get the date created for a file. I think you just mean to create an object. In vbscript, since you already 'dim mostRecent', when using Set, it will automatically assigned to an object.
Hope this will help you :)
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)
This script collects all files in a folder and renames the files by appending the number of lines to the file name. All files are .txt files. The method (since fso.MoveFile and fso.DeleteFile are too particular, generating permissions errors) is to
create the text files,
then create a collection of the files in the folder,
then copy each file into the same folder with a new name, and
finally to delete the original file that was copied.
The script works ok, unless there are no empty text files in the collection. What happens is, the collection gets rebuilt with the new files and the script once again renames the files. I know I can prevent this by checking each file for the existence of certain repeating character strings, but I'd like to know what's happening? Why does the script rebuild the file collection and run through them again renaming each one? This continues on until I kill the process.
Another interesting factoid is, if I happen to trap an empty text file, my message is displayed and the script stops there, but has still reprocessed the first file in the collection a second time. Note that the empty file just happens to be the last one in the collection, but the first filed is once again processed.
So, by design a created text file named 'ab0.txt' gets renamed to 'ab0-15.txt' since it has 15 lines of text in it. What happens is this newly renamed file looks like 'ab0-15-15-15-15-15-15-15-15-15-15.txt'
Questions: What's going on? And is there a better and more efficient way to accomplish this objective?
Here's the code pertinent to the issue:
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(strSaveTo)
Set colFiles = oFolder.Files
' Call Sub to copy and rename
ChangeFileName colFiles
MsgBox("File renaming complete.")
' Exit code
Sub ChangeFileName(collectionSet)
Const ForReading = 1
Dim oFile
For Each oFile In collectionSet
Set LineCnt = fso.OpenTextFile(oFile, ForReading)
If oFile.Size = 0 then
'if this msg is not included, weird things happen
MsgBox("The file named " & oFile & _
" is empty.You may want to verify and manually delete it.")
'[I had some code in here to delete the empty file, but nothing worked]
Else
Do While LineCnt.AtEndOfStream <> True
LineCnt.SkipLine
Loop
lineVar = lineCnt.Line-1
strNewFile = strSaveTo & Left(oFile.name, Len(oFile.name)-4) & _
"-" & lineVar & ".txt"
fso.CopyFile oFile, strNewFile
LineCnt.Close
fso.DeleteFile oFile, True
End If
Next
End Sub
I've heard anecdotal evidence that the Files collection is "live", meaning that newly created files will be added to the collection and iterated over, but I can't find any documentation that says one way or the other. In any case, it's probably a good idea to copy the File objects in the collection to an array first before processing them:
Dim oFile
Dim fileArray()
Dim i
ReDim fileArray(collectionSet - 1)
i = 0
For Each oFile in collectionSet
Set fileArray(i) = oFile
i = i + 1
Next
For Each oFile In fileArray
' Count lines and rename
Next
It seems that collectionSet is the collection of files in the folder that you are trying to modify. The problem is that with each pass through the for-each loop you are adding files to this folder, some of which are fed back into the loop. What you need to do is the find a way to take a snapshot of the folder before you try to iterate over it. The way to do this would be to replace the folder collectionSet by a collection of strings which are the names of the files before you iterate over it, and modify your code to open the files by their name (instead of via a file object). That way the collection won't be expanding while you iterate over it.
You should create your vars in the scope they are used (e.g. your
file/folder objects are used in the sub.
Always explicit(ly) declare your vars.
You don't need to copy the file and rename it then do the delete.
Just rename it with the FileObject.Name property.
Here is an example:
Option Explicit 'always declare your vars!
Dim strFolder: strFolder = "c:\temp\Rename Test"
Dim strExtension: strExtension = "txt"
' Call Sub to rename the files in the folder
ChangeFileName strFolder, strExtension
Sub ChangeFileName(strFolder, strExtension)
Const ForReading = 1
Dim FSO: set FSO = CreateObject("Scripting.FileSystemObject")
Dim objFolder: set objFolder = FSO.GetFolder(strFolder)
Dim colFiles: set colFiles = objFolder.Files
Dim objFile
Dim intCount
Dim strFileName
Dim objTextStream
For Each objFile In colFiles
msgbox "File: " & objfile.path & vbcrlf & FSO.GetExtensionName(objFile.path)
if UCase(FSO.GetExtensionName(objFile.Path)) = UCase(strExtension) and _
objFile.Size > 0 then
'set LineCnt = FSO.OpenTextFile(objFile, ForReading)
set objTextStream = objFile.OpenAsTextStream(ForReading,-2)
intCount = 0
strFileName = objFile.Name
Do While objTextStream.AtEndOfStream <> True
intCount = intCount + 1
objTextStream.ReadLine
Loop
objTextStream.Close
objFile.Name = FSO.GetBaseName(objFile.Path) & "-" & _
intCount & "." & FSO.GetExtensionName(objFile.Path)
end if
Next
End Sub