There is a new, re-written version of this script here:
"Move to Server" - a button script
V1.0 © Rebel154 (4 October 2014)
Used to move selected files to a predefined location.
Requires Directory Opus 126.96.36.199 or later
I created this script to move downloaded installation/update files from my main PC to my server for storage. I originally wrote it as a Rename Script but following help and suggestions from Leo (thank you), I rewrote it as a Button Script.
The script will look for a version string in the file name. If a version string is found, the file name is passed unaltered.
If no version string is found (or could not be determined), the file properties are checked to see if the 'Product Version' property is set. If so, this is inserted into the file name with a leading underscore ("_"). This allows you to move files like DOpusInstall64.exe (which doesn't put the version in the filename but is included in the file proprties) with the version number appended to the file name i.e. DOpusInstall64_188.8.131.52.exe
If the script cannot find a version number at all, you will prompted to enter one and this will be appended to the file name with a leading underscore. If you cancel the dialog, the file name is passed unaltered.
The minimum string length searched for in the file name is 4 characters, made up of digits and dots, including the dot before the extension (i.e. name3.1.exe). This avoids the regular expression test matching '64.' in DOpusInstall64.exe for example. The dot before the ext is stripped from the found string.
The destination folders should be predefined by declaring the keys and corresponding values in the Map object (see below). If a key has not been defined you will be prompted to select a destination folder for that file. If you cancel the dialog, the file will be copied or moved the defined destination path ('desFilePath'). Note that by default the Map is empty so if you don't populate it, you will prompted for the destination folder for every selected file.
PLEASE TEST THE SCRIPT ON YOUR OWN SYSTEM/FILES BEFORE USING IT IN ANGER. Change the 'Testing' variable below to 'False' to actually move and/or delete your files!
I have tested the script using the files below (without changing their names) and it works for me. It may not be foolproof as the regular expression will match any combination of numbers and dots 4 chars or more in length in the file name.
Feel free to suggest amendments and improvements.
To use this script you must set or change 4 variables and populate the Map object to reflect your own set up. These settings are all in the top section of the script after the 'Set DoF' statement.
Copy and paste the code below into a new button. Please ensure you select Script Function and set the language drop-down to VBScript before pasting the script in.
Alternatively, you can use this pre-made button as a starting point:
Set the two variables "Testing" and "DeleteFiles" to True or False. The defaults are 'True' and 'False' respectively. If 'Testing' is 'True' then 'DeleteFiles' is bypassed.
Define the path to your storage location - it can be on a local drive or on your network. The final destination file path ('desFilePath') will be enclosed in double quotes (" ") so that you can use paths/file names with spaces. The destination path must already exist.
Set the 'keyLength' variable to the correct 'key' length as entered below. The default is 3.
Set up the Map Object before you begin or it'll end in tears (you'll be asked for the folder location for every file). Format is '"abc","folder"' where "abc" is the first 3 (by default) characters of your selected file(s) and "folder" is the folder on the destination path. See my example 'Set mapFolders' statement below for clarification. The destination folders must already exist in the destination path.
Please note that the 'key' is case-sensitive. "Cal" is not the same as "cal".
My example folders map:
Set mapFolders = DoF.Map("cal","Calibre\","cdb","CDBXP\","DOp","DOpus\V11\","Dro","Dropbox\","Med","MediaMonkey\","Goo","GoodSync\V9\","iTu","Apple\","Tea","TeamViewer\")
The above assumes that the first 3 letters of any selected file name will be unique - if they are not you can increase the numbers of characters until you do get a unique key. Don't forget to change the 'keyLength' variable if not using the default 3 characters.
The script code that is inside the .dcf file above is reproduced here for reference.
Option Explicit Function OnClick(ByRef ClickData) Dim Testing, DeleteFiles, desPath, mapFolders, keyLength 'user configuration variables - must be set below before use Dim DoF Set DoF = DOpus.Create ' Create a DOpus.Factory object - Do Not Change this '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' Change to 'False' to actually Copy/Delete real files!! Testing = True ' Change this to 'True' to delete the source files after they have been copied. A confirmation dialog will pop up DeleteFiles = False ' The desPath location must already exist. desPath = "D:\Test\" ' Testing location - change this suit your needs keyLength = 3 ' Set this to the number of characters in your map 'key' above ' Predefined destination folders based on file name - the 'key' should match srcStem (the first 3 chars of the selected file name) ' The folder/sub-folder must already exist at the destination. Don't forget the trailing "\" at the end. Set mapFolders = DoF.Map() ' There should be no need to alter anything beyond here (unless I've made an error or there are improvements to be made) '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Dim selFiles, selFile, selStem, file ' Selected files Dim desFile, desFolder, desFilePath, defFolder ' Destination & Defined folder and/or files Dim userVer, fileVer, nameVer ' Version numbers & Map object Dim RegX, Matches, Match, StartPos, dlg, cmd, Return ' RegExp & Misc Dim DeleteConfirm Set dlg = ClickData.Func.Dlg Set cmd = ClickData.Func.command Set selFiles = ClickData.Func.sourcetab.selected_files ' Check that only files are selected. If ClickData.Func.sourcetab.selected_dirs.count > 0 Then dlg.request "Only Files should be selected", "OK" Exit Function End If ' Make sure we have at least one file selected If selFiles.count = 0 Then dlg.Request "Please select some files to move", "OK" Exit Function End If cmd.ClearFiles If Testing = False Then If DeleteFiles = True Then DeleteConfirm = dlg.request("Source Files will be deleted - Confirm", "OK|NO!") Else dlg.request "Source Files will not be deleted", "OK" End If End If ' Process each selected file (File) For Each file In selFiles ' Let's find out if the version number is in the file name and if not ' figure it out (or enter it manually) and insert it into the file name nameVer = "" ' initialise var Set RegX = New RegExp RegX.IgnoreCase = True RegX.Global = False RegX.Pattern = "([0-9]+\.)+" Set Matches = RegX.Execute(selFiles(file).name) For Each Match In Matches nameVer = Left(Match.Value,Len(Match.value)-1) If Len(nameVer) =< 3 Then ' ignore things like the '64' in DOpusInstall64.exe nameVer = "" End If Next Set fileVer = selFiles(file).metadata.exe StartPos = InStr(fileVer.prodversion,NameVer) If nameVer <> "" Then desFile = selFiles(file).name Else If NameVer <> "" And StartPos = 0 Then desFile = selFiles(file).name Else If fileVer.prodversion <> "" Then desFile = selFiles(file).name_stem & "_" & fileVer.prodversion & selFiles(file).ext Else userVer = dlg.GetString("Enter Version # for " & selFiles(file).name,,10,"OK|Cancel","Version Number Required") If userVer = "" Then desFile = selFiles(file).name Else desFile = selFiles(file).name_stem & "_" & userVer & selFiles(file).ext End If End If End If End If selStem = Left(desFile,keyLength) ' Get first letters of selected file name If mapFolders.exists(selStem) Then defFolder = mapFolders(selStem) desFolder = desPath & defFolder Else Set Return = dlg.folder("Select folder for " & desFile,desPath,1) If Return.result = False Then desFolder = desPath Else desFolder = Return & "\" End If End If desFilePath = Chr(34) & desFolder & desFile & Chr(34) selFile = ClickData.Func.sourcetab.path & "\" & selFiles(file).name ' I'm using two commands here (a 'Copy' followed by a 'Delete') because if a file already exists with a ' "Copy Move WHENEXISTS=SKIP", the existing file gets skipped and will remain in the source lister If Testing = True Then DOpus.Output(desFilePath) Else cmd.AddFile selFile If DeleteConfirm <> 0 Then cmd.RunCommand "Copy WHENEXISTS=SKIP AS " & Chr(34) & desFile & Chr(34) & " To=" & Chr(34) & desFolder & Chr(34) cmd.RunCommand "Delete QUIET" Else cmd.RunCommand "Copy WHENEXISTS=SKIP AS " & Chr(34) & desFile & Chr(34) & " To=" & Chr(34) & desFolder & Chr(34) End If cmd.ClearFiles End If Next End Function