Enhanced "Create Dated Folder", with space removal, Customizable

Buttons/Scripts
, ,
1

In company server directory, I always try to organized/archive folders in chronological order (YYYYMMDD), but also always avoid space in the file names to avoid Hyperlink breaking while sharing the link.
The embedded feature doesn't quite serve all my requirement so I took the liberty to have another try.
image

Option Explicit
Function OnClick(ByRef clickData)
    Dim cmd
    Set cmd = clickData.func.command   
	cmd.deselect = false ' Prevent automatic deselection
    cmd.ClearFiles 'Bug fixed! Unselect All, to prevent error "Creating subfolder of selected folder"
    Dim dlg, ret
    Set dlg = DOpus.Dlg 
    dlg.window = DOpus.Listers(0)
    dlg.message = "Enter your folder name"
    dlg.title = "Create New Folder | Bryan"
    dlg.buttons = "OK|Cancel"
    dlg.max = 128  ' enable the text field
    ' dlg.icon = "warn"
    dlg.options(0).label = "Replace Space + Add Date Prefix"
    dlg.options(0).state=True
    ret = dlg.Show
    DOpus.Output "Dialog.Show returned " & ret
    DOpus.Output "The string you entered was " & dlg.input
    DOpus.Output "The two checkboxes were set to " & dlg.options(0).state

'TODO: Check if target folder-name occupied
    dim sInput, sActual
    If ret = 1 then
        sInput=dlg.input    
        If dlg.options(0).state then
            sActual=Replace(sInput," ", "_")
            sActual=YYYYMMDD & "_" & sActual
        Else
            sActual=sInput
        End If
        cmd.RunCommand "CreateFolder NAME=""" & sActual & """ READAUTO=yes"
    End If
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

By modifying the Functions "YYMMDD" or "YYYYMMDD" with dashs you can customize into the style as you wish.
Dated Folder.dcf (3.2 KB)

4 Likes