In many companies or driven purely by personal wills, you would tend to name your files with #Date_Version# suffix to make things neat. -- In my case, I will use #yymmdd# or #yyyymmdd#, to make sure files are automatically sorted in chronological order.
However this causes pain while you copy file into todays version -- you have to copy yesterday's file and rename it carefully.
This Script Button is to cover that little pain to do it automatically.
- Execute on file that not fitting the naming pattern, nothing happens it'll ask you to create into naming-complaint file from today or not
- Execute on naming-complaint file, copy and rename into today's version #1 => if target filename exists then prompt into #2,3,4... or replace it
Only works on files yet, and I'll think on folders further.
I am not in coding profession, so in case you see smarter way of the codes, I would love to be pointed out 
Hope it helps with you.
Copy2Today.dcf (8.7 KB)
updated 2020-03-18T16:00:00Z
Option Explicit
Function OnClick(ByRef clickData)
DOpus.ClearOutput
Dim cmd, lister, tab, selItem, folderEnum, folderItem
' ---------------------------------------------------------
Set cmd = clickData.func.command
' cmd.deselect = false ' Prevent automatic deselection
' DOpus.Output "Selected items in " & clickData.func.sourcetab.path & ":"
If clickData.func.sourcetab.selected.count = 0 OR clickData.func.sourcetab.selected(0).is_dir Then
' DOpus.Output " (none)"
Exit function
Else
' DOpus.Output " (f) " & clickData.func.sourcetab.selected(0).RealPath
Set selItem=clickData.func.sourcetab.selected(0)
dim sDirectorySlash, sNameExt, sName ,sExt
sDirectorySlash=left(selItem.RealPath,(InStrRev(selItem.RealPath,"\")))
' DOpus.Output sDirectorySlash
sNameExt = Right(selItem.RealPath,Len(selItem.RealPath)-(InStrRev(selItem.RealPath,"\")))
sExt = right(sNameExt,len(sNameExt)-InStrRev(sNameExt,".")+1)
' DOpus.Output sNameExt & sExt
sName = left(sNameExt,InStrRev(sNameExt,".")-1)
' DOpus.Output sName
dim test, pat8, pat6
' test = "List of open points_20190209_v#"
' pat1 = "........_v.$"
pat8 = "[0-9]{8}_v.$"
pat6 = "[0-9]{6}_v.$"
' DOpus.Output(test & " RegEx """ & pat & """ = " & RegExTest(test, pat))
' DOpus.Output(RegExTest(sName, pat1))
dim sLeftPart, sOldDate, sNewDate, sNewVer, sOldVer, sNewName
sOldVer = right(sName,1)
if RegExTest(sName, pat8) Then
sLeftPart=left(sName, len(sName)-11)
sOldDate = right(left(sname,len(sname)-3),8)
sNewDate=YYYYMMDD
sNewVer = 1
if sOldDate=YYYYMMDD then
sNewVer = cstr(sOldVer +1)
end if
sNewName=sLeftPart & sNewDate & "_v" & sNewVer
' msgbox sNewName
' msgbox "True1"
' msgbox YYMMDD & YYYYMMDD
elseif RegExTest(sName, pat6) Then
sLeftPart=left(sName, len(sName)-9)
sOldDate = right(left(sname,len(sname)-3),6)
sNewDate=YYMMDD
sNewVer = 1
if sOldDate=YYMMDD then
sNewVer = cstr(sOldVer +1)
end if
sNewName=sLeftPart & sNewDate & "_v" & sNewVer
' msgbox sNewName
else
dim iCreateNow
iCreateNow=msgbox( "The file is not named properly." & chr(10) & chr(13) & "Would you like to create a proper version from today?", vbYesNoCancel, "Copy2Today")
select case iCreateNow
case vbYes
sNewDate=YYYYMMDD
sNewVer = 1
sNewName=sName & "_" & sNewDate & "_v" & sNewVer
case vbno
exit function
end select
end if
dim sNewFullName
sNewFullName=sDirectorySlash & sNewName & sExt
dim fso, oldfile
set fso = CreateObject ("Scripting.FileSystemObject")
if fso.FileExists(sNewFullName) then
dim iRes
iRes=msgbox( "The target today version is already existing." & chr(10) & chr(13) & "Do you want to replace it or create into newer version? if No you will replace v1.", vbYesNoCancel, "Copy2Today")
select case iRes
case vbYes
do while fso.FileExists(sNewFullName)
sNewFullName=left(sNewFullName,len(sNewFullName)-len(sExt)-1) & cstr(right(left(sNewFullName,len(sNewFullName)-len(sExt)),1)+1) & sExt
Loop
case vbno
fso.deletefile(sNewFullName)
case else
exit function
end select
end If
set oldfile = fso.GetFile (selItem.RealPath)
oldfile.Copy(sNewFullName)
' clickData.func.sourcetab.selected.AddFile sNewFullName
cmd.AddFile sNewFullName
cmd.RunCommand "Select FROMSCRIPT"
End If
End Function
Function RegExTest(str, pat)
dim RE
Set RE = New RegExp
RE.IgnoreCase = True
RE.Pattern = pat
RegExTest = RE.Test(str)
End Function
Function YYMMDD()
Dim t
t=Now
YYMMDD=Right(Year(t),2) & Right("0" & Month(t),2) & Right("0" & Day(t),2)
End Function
Function YYYYMMDD()
Dim t
t=Now
YYYYMMDD=Year(t) & Right("0" & Month(t),2) & Right("0" & Day(t),2)
End Function
