NEW VERSION:
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 11.7.1.0 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_11.7.3.0.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.
MediaMonkey_4.1.5.1717.exe
GoodSync-Setup.exe
calibre-64bit-2.5.0.msi
DOpusInstall64.exe
Dropbox 2.10.30.exe
TeamViewer_Setup_en.exe
iTunes64Setup_11.4.0.18.exe
audacity-win-2.0.5.exe
Feel free to suggest amendments and improvements.
INSTRUCTIONS
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.
Script Code
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