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.
Related
I am writing a VBScript to try to compress multiple directories in different locations into the same Zip file.
The current solution I am using is to iterate over the directories I want to compress (of which there are currently 2), get the file objects and use the copyHere method to copy the source folder into a zip file with the proper header format.
That part seems to be working okay, the difficulty I am having is with the error checking. The only two solutions I have found online are to get the count of objects in the source and target directories and sleep until they are the same, or to check if the zip file is open for appending and sleep until it is.
The first option is easy with one directory but becomes much more tedious with multiple folders, not to mention that Windows will likely create an object in the target directory before it has finished copying and I am compressing files potentially over 10 GB so that solution won't work.
I had tried to implement the second solution but every time the loop got to the second call to CopyHere it would tell me that the zip file was corrupted from the first iteration. Is it not possible to compress very large files to a zip with VBScript?
Any other suggestions as to how I can error check that the compressing is done using VBScript would be very helpful.
Here is a Function Create_WinRar_Archive(Source,Target_Archive,Password) to compress a folder with rar.exe command line of Winrar.
We can call this function by two ways :
If you want create an archive without password, so we called it by this way :
Call Create_WinRar_Archive(Source,Target_Archive,"")
or if you want to set to this archive a password just we called it as :
Call Create_WinRar_Archive(Source,Target_Archive,Password)
And here is an example to compress the Pictures folder
Option Explicit
Dim ws,Source,Target_Archive,Password
Set ws = CreateObject("Wscript.Shell")
Source = ws.ExpandEnvironmentStrings("%userprofile%\pictures")
Target_Archive = "C:\BackupImages.rar"
Password = "123456"
Call Create_WinRar_Archive(Source,Target_Archive,Password)
Wscript.echo "All files are archived successfully !"
ws.run "Explorer " & Target_Archive
'******************************************************************************************************
Function Create_WinRar_Archive(Source,Target_Archive,Password)
'This function executes the command line
'version of WinRAR and reports whether
'the archive exists after WinRar exits.
'If it exists then it returns true. If
'not it returns an error message.
'------------------------------------------------------------------------------------
Dim oFSO,oShell,aScriptFilename,sScriptFilename
Dim sWorkingDirectory,ProgramFiles,sWinRarLocation
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Wscript.Shell")
'--------Find Working Directory--------
aScriptFilename = Split(Wscript.ScriptFullName, "\")
sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
'-------Ensure we can find Winrar.exe------
If oFSO.FileExists(sWorkingDirectory & " " & "Winrar.EXE") Then
sWinRarLocation = ""
ElseIf oFSO.FileExists(oShell.ExpandEnvironmentStrings("%ProgramFiles%\Winrar\rar.exe")) Then
sWinRarLocation = oShell.ExpandEnvironmentStrings("%programfiles%\Winrar\")
ElseIf oFSO.FileExists(oShell.ExpandEnvironmentStrings("%ProgramFiles(x86)%\Winrar\rar.exe")) Then
sWinRarLocation = oShell.ExpandEnvironmentStrings("%programfiles(x86)%\Winrar\")
Else
Create_WinRar_Archive = "Error: Couldn't find Winrar.EXE"
Exit Function
End If
'--------------------------------------
'The Command "A" Means ==> add to archive
'To create a WinRar file with the specified name after command A (archive) and the switches -ep1 (exclude base directory from names) and -r (recursive)
If Password = "" Then
oShell.Run """" & sWinRarLocation & "rar.exe"" A -ep1 -r """ & _
Target_Archive & """ """ & Source & """",0,True
Else
'The -hp<password> switch: To use a password
oShell.Run """" & sWinRarLocation & "rar.exe"" A -ep1 -r -hp"&Password&" """ & _
Target_Archive & """ """ & Source & """",0,True
End If
If oFSO.FileExists(Target_Archive) Then
Create_WinRar_Archive = 1
Else
Create_WinRar_Archive = "Error: Creating archives failed !"
MsgBox Create_WinRar_Archive,16,Create_WinRar_Archive
End If
End Function
'****************************************************************************************************
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.
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.
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
Open App.Path & "\Folder\" & str(0) For Output
Seems to get a path not found however if directly before that I do
MsgBox App.Path & "\Folder\" & str(0)
It Provides the correct directory/filename that I want
and if I replace that string with the direct path in quotes it works fine however that won't be very good for other users of my app :( Anyone know why this doesn't work?
You can open a file that doesn't exist. I tried it with:
Open "c:\temp\test.txt" & Str(0) For Output As #1
Close #1
When it ran it created c:\temp\test.txt 0
Note that I added "As #1" to the Open statement, and taht Str(0) adds a leading space for the optional minus sign (CStr(0) doens't add a leading space)
Comment: You can open a file that doesn't exist.
Only true if your folder exist. If both your folder and file does not exist, it will give a "path not found" error.
Here something easy i made for you:
Function CreateLog(Destination As String, MyMessage As String)
Dim PathToCreate, FolderPath, FileName As String
'Check for Unnecessary Spaces
Destination = Trim(Destination)
FolderStr = Destination
'Gather only FolderPath of Destination
Do
FolderStr = Mid(FolderStr, 1, Len(FolderStr) - 1)
Loop Until Right(FolderStr, 1) = "\" Or Len(FolderStr) < 1
'Gather only FileName
FileName = Mid(Destination, Len(FolderStr) + 1, Len(Destination) - Len(FolderStr))
'If the path does not exist than create it
'Recursive approach
For Each Folder In Split(FolderStr, "\")
If InStr(1, Folder, ":") = 0 Then
PathToCreate = PathToCreate & "\" & Folder
Else
PathToCreate = Folder
End If
If fso.FolderExists(PathToCreate) = False And PathToCreate <> "" Then
fso.CreateFolder PathToCreate
End If
Next
'Open file and add the message in it
Open PathToCreate & "\" & FileName & ".txt" For Append As #1
Print #1, MyMessage
Close #1
End Function
Usage:
CreateLog "D:\Test\NewTest\NewFolder\AnotherFolder\atlastthefile.abcdefg", "Hello!"
Doesnt matter what fileExtention given cause ill add ".txt" anyways..