Move files to predefined location, appending version numbers

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.

  1. 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:

  2. 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.

  3. 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.

  4. Set the 'keyLength' variable to the correct 'key' length as entered below. The default is 3.

  5. 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