Here's a script I've been using for myself to open/create(if it doesn't exist) a dated folder in a particular directory (called Open Today.vbs
)
It's long because I had to add Date formatting functions to it. I am just posting it here as an alternative for the other inquiring minds. The AHK solution is so much simpler
, but this might be useful when you need it in a pinch. This could easily be customized to accept arguments as well.
Save as Open Today.vbs
Dim sNow, strDateTime, sPath, sFinalPath
'sPath = "PUT YOUR FOLDER NAME BELOW"
sPath = "C:\YourFolder"
'TESTING CODE
sNow = Replace(Replace(Now(),"/","-"),":",".")
sNow = Year(Date) & Month(Date) & Day(Date)'& MonthName(Date)
'Wscript.Echo sNow
'Wscript.echo FormateDateTime(Date(),vblongdate)
'END TESTING CODE
'Generate Full PathName
'strDateTime = formatDate("%g:%i%a, %l %j%O %F, %Y", UDate(Now()))
strDateTime = formatDate("%Y-%m %M\%Y-%m-%d\", Now())
sNow = formatDate("%Y-%m %M\", Now())
'Wscript.echo strDateTime
sFinalPath = sPath & strDateTime
'Create the folder if it doesn't exist
On Error Resume Next
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(sFinalPath) Then
'Check Subfolder level and create those first?
If Not fso.FolderExists(sPath & sNow) Then fso.CreateFolder(sPath & sNow)
Wscript.echo "Creating: " & sFinalPath
fso.CreateFolder(sFinalPath)
End If
If (Err.Number <> 0) Then
Wscript.Echo "Error creating folder! " & Err.Number & " :" & Err.Description
Err.Clear
On Error GoTo 0
Wscript.Quit
Else
End If
On Error GoTo 0
'Open the folder
Dim shAppObj
If MsgBox( "Open Folder?" & vbcrlf & sFinalPath, vbYesNo + vbQuestion, "Create\Open Folder?") = vbYes Then
Set shAppObj = nothing
Set shAppObj = CreateObject("WScript.Shell")
shAppObj.Run "explorer " & sFinalPath
End If
Set shAppObj = nothing
Wscript.Quit
'Recursively create parent folders if they do not exist
'Sub CreateMissingFolders(strPath)
'Dim fso, sParent
'Set fso = CreateObject("Scripting.FileSystemObject")
'If Not fso.FolderExists(strPath) Then
'Check Subfolder level and create those first?
' sParent = Mid(1,
' CreateMissingFolder()
' Wscript.echo sFinalPath
' fso.CreateFolder(strPath)
'End If
'End sub
Function unUDate(intTimeStamp)
unUDate = DateAdd("s", intTimeStamp, "01/01/1970 00:00:00")
end Function
Function UDate(oldDate)
UDate = DateDiff("s", "01/01/1970 00:00:00", oldDate)
end Function
Function formatDate(format, intTimeStamp)
Dim monthname()
Redim monthname(12)
monthname(1) = "January"
monthname(2) = "February"
monthname(3) = "March"
monthname(4) = "April"
monthname(5) = "May"
monthname(6) = "June"
monthname(7) = "July"
monthname(8) = "August"
monthname(9) = "September"
monthname(10) = "October"
monthname(11) = "November"
monthname(12) = "December"
dim unUDate, A
dim OriginalLocale
dim res
OriginalLocale = GetLocale
res = SetLocale("en-gb")
' Test to see if intTimeStamp looks valid. If not, they have passed a normal date
if not (isnumeric(intTimeStamp)) then
if isdate(intTimeStamp) then
intTimeStamp = DateDiff("S", "01/01/1970 00:00:00", intTimeStamp)
else
response.write "Date Invalid"
exit function
end if
end if
if (intTimeStamp=0) then
unUDate = now()
else
unUDate = DateAdd("s", intTimeStamp, "01/01/1970 00:00:00")
end if
unUDate = trim(unUDate)
'bug fix for midnight problems
If (Len(unUDate) <= 11) Then unUDate = Trim(unUDate) & " 00:00:00"
dim startM : startM = 1
dim startD : startD = InStr(startM, unUDate, "/")+1
dim startY : startY = InStr(startD, unUDate, "/")+1
dim startHour : startHour = InStr(startY, unUDate, " ")+1
dim startMin : startMin = InStr(startHour, unUDate, ":")+1
dim startSec : startSec = InStr(startMin+1, unUDate, ":")+1
dim dateMonth : dateMonth = mid(unUDate, startD, ((startY - 1) - startD))
dim dateDay : dateDay = mid(unUDate, 1, ((startD - 1) - 1))
dim dateYear : dateYear = Year(unUDate)
dim dateHour : dateHour = mid(unUDate, startHour, ((startMin - startHour) - 1))
dim dateMinute : dateMinute = mid(unUDate, startMin, 2)
dim dateSecond : dateSecond = mid(unUDate, InStr(startMin, unUDate, ":") + 1, 2)
format = replace(format, "%Y", right(dateYear, 4))
format = replace(format, "%y", right(dateYear, 2))
format = replace(format, "%m", dateMonth)
format = replace(format, "%n", cint(dateMonth))
' Response.Write CStr(cint(dateMonth))
' Response.Flush
format = replace(format, "%F", monthname(cint(dateMonth)))
format = replace(format, "%M", left(monthname(cint(dateMonth)), 3))
format = replace(format, "%d", dateDay)
format = replace(format, "%j", cint(dateDay))
format = replace(format, "%h", mid(unUDate, startHour, 2))
format = replace(format, "%g", cint(mid(unUDate, startHour, 2)))
if (cint(dateHour) > 12) then
A = "PM"
else
A = "AM"
end if
format = replace(format, "%A", A)
format = replace(format, "%a", lcase(A))
if (A = "PM") then format = replace(format, "%H", Right("00" & dateHour - 12, 2))
format = replace(format, "%H", dateHour)
if (A = "PM") then format = replace(format, "%G", left("0" & cint(dateHour) - 12, 2))
format = replace(format, "%G", cint(dateHour))
format = replace(format, "%i", dateMinute)
format = replace(format, "%I", cint(dateMinute))
format = replace(format, "%s", dateSecond)
format = replace(format, "%S", cint(dateSecond))
format = replace(format, "%L", WeekDay(unUDate))
format = replace(format, "%D", left(WeekDayName(WeekDay(unUDate)), 3))
format = replace(format, "%l", WeekDayName(WeekDay(unUDate)))
format = replace(format, "%U", intTimeStamp)
format = replace(format, "11%O", "11th")
format = replace(format, "1%O", "1st")
format = replace(format, "12%O", "12th")
format = replace(format, "2%O", "2nd")
format = replace(format, "13%O", "13th")
format = replace(format, "3%O", "3rd")
format = replace(format, "%O", "th")
formatDate = format
res = SetLocale(OriginalLocale)
End Function
Edit: Fixed typo
OpenTodaysFolder.exe
)