Basically, I need a script to move files to another folder that have been accessed and modified.
I'm new to scripting, so this may be a simple problem, but I'm stumped. Here's the error I'm getting:
Script: C:\Users\bmcwilliams\Desktop\pssitest.vbs
Line: 17
Char: 10
Error: File already exists
Code: 800A003A
Source: Microsoft VBScript runtime error
The destination folder is empty, so I'm not sure what's going on.
Below is the code I have. It's modified from the code listed in this post:
How to move files from a directory to another directory based on file size
' use a default source path
dim sourcepath: sourcepath = "C:\users\bmcwilliams\Desktop\TestUncompleted"
' use a default destination path
dim destinationpath: destinationpath = "C:\users\bmcwilliams\Desktop\TestCompleted"
dim fso: set fso = CreateObject("Scripting.FileSystemObject")
dim sourcefolder: set sourcefolder = fso.GetFolder(sourcepath)
' loop through each file in the directory, compare size property against
' the limit and copy as appropriate
dim file, count: count = 0
for each file in sourcefolder.Files
dim createDate: createDate = file.DateCreated
dim modifyDate: modifyDate = file.DateLastModified
if createDate <> modifyDate Then
file.Move destinationpath
count = count + 1
end if
next
WScript.Echo("complete: " & count & " file(s) moved")
Any ideas? Any input is greatly appreciated. Thanks!
You are copying to the new location but do not supply the new name of the file. To fix the issue append a \ and the file name to the destination path.
file.Move destinationpath +"\" + file.name
If the destination path for moving a file is a folder and not the full path (including the destination filename), it must have a trailing backslash:
destinationpath = "C:\users\bmcwilliams\Desktop\TestCompleted\"
Otherwise the Move operation would detect that the destination (the folder) already exists and would thus fail.
Related
I have a folder which contains various tif files.I am using a simple move command which reads as
move "Source path/File name" "Destination path/"
I have tried a command which reads as:
move "Source path/File 1, File 2. File 3" "Destination Path/"
I am looking for a similar formula which can help me out. The reason why this code is important for me
In a scenario where iam moving only one file to destination folder
In another scenario, I have to choose 3 or more files to another destination folder. If I do this with generic formula it takes a longer time to accomplish.
Please do suggest on this.
move "Source path/File 1, File 2. File 3" "Destination Path/"
In a scenario where I am moving only one file to destination folder.
In another scenario, I have to choose 3 or more files to another destination folder.
Example:
Sample
If I do this with generic formula it takes a longer time to accomplish.
You might try the code below.
Sub MoveFiles()
Dim DestinationPath As String
Dim SourcePath As String
Dim FileNames As String
Dim Sp() As String
Dim i As Integer
SourcePath = Environ("USERPROFILE") & "\Desktop"
DestinationPath = "H:\TestFolder"
FileNames = "File1.txt,File2.txt,File3.txt"
If Right(SourcePath, 1) <> "\" Then SourcePath = SourcePath & "\"
If Right(DestinationPath, 1) <> "\" Then DestinationPath = DestinationPath & "\"
If Len(FileNames) Then
Sp = Split(FileNames, ",")
For i = 0 To UBound(Sp)
Sp(i) = Trim(Sp(i))
If Len(Dir(SourcePath & Sp(i))) Then
Name SourcePath & Sp(i) As DestinationPath & Sp(i)
End If
Next i
End If
End Sub
Set the Source and Destination paths according to your system. Enter as many or as few file names in one comma separated string. All named files will be moved if they exist at the SourcePath. If the destination path doesn't exist an error will occur.
I work in the IT office of a County Government Agency and we are tasked with, among other things, imaging and setting up computers for the employees. One of our application providers has given us an installer for their application that, upon installation, creates randomized folder names within the parent folder. I am looking for a VBScript that will create a shortcut of a .exe from a directory with unknown sub-folder names and place it in the Public Desktop folder. I have also discovered that the vendor has included two instances of the same application in two different sub-folders. I am only interested in using the path from the first .exe located. I found a script online, (unfortunately, I do not remember where I found it. So, I am unable to give credit to the individual who wrote it), that creates a shortcut if the path is known. I have edited the script by adding some variables and including more icon settings for the shortcut. I am extremely new to scripting, so, I am unable to modify this script to find the path to the .exe and then use the path to create the shortcut. The first .exe is located three sub-folders deep and all three folders have randomized names. Any help is greatly appreciated.
' This script creates a shortcut of MyApp and places it in the Public Desktop folder for all users
Option Explicit
Dim objWSH, objFSO, link, desktopPath, AppPath, IconPath, DirPath
DirPath = "C:\Program Files\MyApp Folder\Randomized1\Randomized2\Randomized3"
IconPath = "C:\Program Files\MyApp Folder\Randomized1\Randomized2\Randomized3\ApplicationIcon.ico"
AppPath = "C:\Program Files\MyApp Folder\Randomized1\Randomized2\Randomized3\MyApp.exe"
Set objWSH = WScript.CreateObject("WScript.Shell")
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
desktopPath = "C:\Users\Public\Desktop"
' If file exists define where the shortcut should point to
If objFSO.FileExists(AppPath) Then
set link = objWSH.CreateShortcut(desktopPath & "\MyApp.lnk")
' Define icon settings
link.TargetPath = AppPath
link.IconLocation = IconPath
link.Description = "MyApp"
link.WindowStyle = 2
link.WorkingDirectory = DirPath
link.Save
Else
WScript.Echo "Program file does not exist"
End if
You should be able to modify this to find the files that you want.
Get all files from a directory and it's sub-directories
GetFileList returns an 1 dimensional array of FileInformation.
Function getFileList(localRoot, fld, ftpArray)
Dim fso, f, baseFolder, subFolder, ftpFile, i
Set fso = CreateObject("Scripting.Filesystemobject")
If IsNull(fld) Then
Set baseFolder = fso.GetFolder(localRoot)
Else
Set baseFolder = fld
End If
For Each f In baseFolder.Files
If IsNull(ftpArray) Then
ReDim ftpArray(0)
Else
i = UBound(ftpArray) + 1
ReDim Preserve ftpArray(i)
End If
Set ftpFile = New FileInformation
ftpFile.setValues localRoot, fso, f
Set ftpArray(i) = ftpFile
Next
For Each subFolder In baseFolder.SubFolders
getFileList localRoot, subFolder, ftpArray
Next
getFileList = ftpArray
End Function
Class FileInformation
Public FilePath
Public FolderPath
Public FileExtension
Public Sub setValues(localRoot, fso, f)
FilePath = f.Path
FolderPath = f.ParentFolder.Path
FileExtension = fso.GetExtensionName(FilePath)
End Sub
End Class
This will search all the FileInformation collected.
File Path: f.FilePath
Folder Path: f.FolderPath
File Extension: f.FileExtension
Const localRootFolder = "C:\Program Files\MyApp Folder"
Dim filelist, f
filelist = getFileList(localRoot, Null, Null)
For Each f In filelist
Next
After more research and testing, I decided to use Command Line to find the path. After getting the syntax right, it works flawlessly. I have included my final script below. I hope this can help someone else. I went here, Running command line silently with VbScript and getting output?, to help me with using Command Line in VBScript. I then found this, https://blogs.technet.microsoft.com/heyscriptingguy/2007/11/08/hey-scripting-guy-how-can-i-remove-a-value-from-the-path-environment-variable/, which shows how to use the Replace function so I could remove MyApp.exe from the path. I then added that to my original script and it worked.
' This script creates a shortcut of the MyApp application and places it in the Public Desktop folder for all users.
Option Explicit
Dim objExec, output, objDir, objWSH, objFSO, link, DesktopPath, AppPath, IconPath, DirPath
Set objWSH = WScript.CreateObject("WScript.Shell")
Set objExec = objWSH.Exec("Where /R ""C:\Program Files\MyApp"" ""MyApp.exe"" ")
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
output = objExec.StdOut.ReadLine
DirPath = Replace(output, "\MyApp.exe", "")
IconPath = (DirPath & "\MyAppIcon.ico")
AppPath = (DirPath & "\MyApp.exe")
DesktopPath = "C:\Users\Public\Desktop"
' If file exists define where the shortcut should point to
If objFSO.FileExists(AppPath) Then
set link = objWSH.CreateShortcut(DesktopPath & "\MyApp.lnk")
' Define icon settings
link.TargetPath = AppPath
link.IconLocation = IconPath
link.Description = "MyApp"
link.WindowStyle = 3
link.WorkingDirectory = DirPath
link.Save
Else
WScript.Echo "Program file does not exist"
End If
What I wish to do is:
Copy files from a variety of sub-folders under a single main folder to a destination folder.
Three options when copying:
If no file in destination folder exists then copy.
If file exists, copy over if filesize is larger than destination file.
If file exists and both are the same filesize compare date/time and copy over if most recent.
Here is my pseudocode so far:
Dim filesys, strSourceFile, strDestFolder, strDestFile
Set filesys = CreateObject("Scripting.FileSystemObject")
strSourceFile = S:\SoCal\Section_2\*\Autogen\texture\*.agn
strDestFolder = F:\ADDON_SCENERY\simwestSOCAL\texture
strDestFile = F:\ADDON_SCENERY\simwestSOCAL\texture\*.agn
COPY each file in strSourceFolder
If IsEmpty (SourceFile, DestFolder)
Else If (SourceFile FileSize > DestFile)
Else If (SourceFile DateTime > DestFile DateTime)
Then 'keep/copy most recent file
End if
Am I on the right track?
Do I need to add a Loop?
Can one compare file sizes? All my research has found nothing yet on this.
Can I compare Date and Time against files?
As an update to my original post... (hope I am following forum rules correctly),
I have spent the last several weeks non-stop just reading-reading-reading and testing-failure-testing. I am happy to say (and a little proud), that I have completed my very first script... and it appears to work as planned but for just one file. I now need to convert this to work on all files inside my 'sourcefolder'.
I am a bit "brain dead" from this so any direction on converting this would be most appreciated. I know I need loops but what type and where? Do I rename everything referring to a file to a folder or use '*.txt' for files? In the meantime I will keep studying.
Here is my script (yea, lot's of MsgBox's so I could follow along the script path):
dim dFolder
dFolder = "S:\Scripting Workfolder\destfolder\"
dim dFile
dFile= "S:\Scripting Workfolder\destfolder\File 1.txt"
dim sFile
sFile = "S:\Scripting Workfolder\sourcefolder\File 1.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
'Check to see if the file already exists in the destination folder
If Not fso.FileExists(dFile) Then
MsgBox "File does not exist - will copy over to dFolder"
fso.CopyFile sFile, dFolder, true
Elseif fso.FileExists(dFile) Then
MsgBox "File already exist in destination folder determine largest"
ReplaceIfLarger sFile, dFile
End If
Sub ReplaceIfLarger(sFile, dFile)
const overwrite_existing = true
dim objFSO
set objFSO = createobject("Scripting.FileSystemObject")
dim objSourceFile
set objSourceFile = objFSO.GetFile(sFile)
'dim kbSourceSize
kbSourceSize = objSourceFile.size
dim objTargetFile
set objTargetFile = objFSO.GetFile (dFile)
'dim kbTargetSize
kbTargetSize = objTargetFile.size
If kbSourceSize > kbTargetSize Then
MsgBox "Source file is LARGER and will overwrite to dest folder"
objFSO.CopyFile objSourceFile.Path, objTargetFile.Path, overwrite_existing
ElseIf kbSourceSize < kbTargetSize Then
MsgBox "Source file is smaller - Will not overwrite to dest folder"
Else
ReplaceIfNewer sFile, dFile
End If
End Sub
Sub ReplaceIfNewer(sFile, dFile)
MsgBox "Both files exist and are the same size. Keep newest file"
const overwrite_existing = true
dim objFSO
set objFSO = createobject("Scripting.FileSystemObject")
dim dtmSourceFile
set dtmSourceFile = objFSO.GetFile(sFile)
dim dtmTargetFile
set dtmTargetFile = objFSO.GetFile(dFile)
If (dtmSourceFile.DateLastModified > dtmTargetFile.DateLastModified) then
MsgBox "Source File is Newer than Target File - Overwrite Target file"
objFSO.CopyFile dtmSourceFile.Path, dtmTargetFile.Path, overwrite_existing
Else
MsgBox "Source File is Older than Target File - Will not overwrite file"
End If
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.
I have a vbscript that is used to rename files. What I need to implement into the script is something that deletes the "new file" if it already exists.
For example: I have a batch of files that are named like this 11111111.dddddddd.pdf where the files get renamed to 11111111.pdf. The problem is that when I rename to the 11111111.pdf format I end of with files that are duplicated and then makes the script fail because you obviously cant have 2 files with the same name. I need it to rename the first one but then delete the others that are renamed the same.
Here is what I have so far for my IF statement but it doesnt work and I get and error that says "Type mismatch: 'FileExists". I am not sure how to get this part of the code to execute the way I would like. Any help or suggestions would be greatly appreciated.
dim infolder: set infolder = fso.GetFolder(IN_PATH)
dim file
for each file in infolder.files
dim name: name = file.name
dim parts: parts = split(name, ".")
dim acct_, date_
acct_ = parts(0)
date_ = parts(1)
' file format of a.c.pdf
if UBound(parts) = 2 then
' rebuild the name with the 0th and 2nd elements
dim newname: newname = acct_ & "." & parts(2)
' use the move() method to effect the rename
file.move fso.buildpath(OUT_PATH, newname)
if newname = FileExists(file.name) Then
newname.DeleteFile()
end if
end if
next 'file
You're close, you just need to delete the file before trying to over-write it.
dim infolder: set infolder = fso.GetFolder(IN_PATH)
dim file: for each file in infolder.Files
dim name: name = file.name
dim parts: parts = split(name, ".")
if UBound(parts) = 2 then
' file name like a.c.pdf
dim newname: newname = parts(0) & "." & parts(2)
dim newpath: newpath = fso.BuildPath(OUT_PATH, newname)
' warning:
' if we have source files C:\IN_PATH\ABC.01.PDF, C:\IN_PATH\ABC.02.PDF, ...
' only one of them will be saved as D:\OUT_PATH\ABC.PDF
if fso.FileExists(newpath) then
fso.DeleteFile newpath
end if
file.Move newpath
end if
next
fileExists() is a method of FileSystemObject, not a global scope function.
You also have an issue with the delete, DeleteFile() is also a method of FileSystemObject.
Furthermore, it seems you are moving the file and then attempting to deal with the overwrite issue, which is out of order. First you must detect the name collision, so you can choose the rename the file or delete the collision first. I am assuming for some reason you want to keep deleting the new files until you get to the last one, which seemed implied in your question.
So you could use the block:
if NOT fso.FileExists(newname) Then
file.move fso.buildpath(OUT_PATH, newname)
else
fso.DeleteFile newname
file.move fso.buildpath(OUT_PATH, newname)
end if
Also be careful that your string comparison with the = sign is case sensitive. Use strCmp with vbText compare option for case insensitive string comparison.
IF both POS_History_bim_data_*.zip and POS_History_bim_data_*.zip.trg exists in Y:\ExternalData\RSIDest\ Folder then Delete File Y:\ExternalData\RSIDest\Target_slpos_unzip_done.dat