Is there a way to pass Today's date as a command line argument to Excel from a Windows Task Scheduler Job

Question

We have have a Windows Task Scheduler job that runs an Excel xlsm file with some command line arguments as below:

    Program/script:
    "C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE"

    Add arguments (optional):
    "C:\File\Path\MyMacroEnabledFile.xlsm" /e/Arg1,Arg2

We would like to add a third argument with today's date, which would display in Task Manager something like the following:

    "C:\File\Path\MyMacroEnabledFile.xlsm" /e/Arg1,Arg2,03-30-2024

The reason for that requirement is that the job sometimes hiccups and we have a demand job that spins through WMI processes and terminates running Excel instances based on checking the command line. It would be really helpful to see the date in the Task Manager Command Line column.

When you google Excel Command Line Arguments there are lots of examples for all kinds of things, but I can't find one that speaks to a Date command line argument. I have tried:

    "C:\File\Path\MyMacroEnabledFile.xlsm" /e/Arg1,Arg2,%date
    "C:\File\Path\MyMacroEnabledFile.xlsm" /e/Arg1,Arg2,%date%
    "C:\File\Path\MyMacroEnabledFile.xlsm" /e/Arg1,Arg2,%Now
    "C:\File\Path\MyMacroEnabledFile.xlsm" /e/Arg1,Arg2,%Now%

Answer 1

Bifore editing I placed a piece of code able to extract arguments and place them in a sheet of the handled workbook...

Now, I think the previous solution can be used to also answer the question, as it is formulated...

1. How to be prepared the workbook handled by Scheduler:

a. Please, insert a standard module, name it "CmdLineExtractString", and copy the next code inside it:

Option Explicit

#If VBA7 Then
  Declare PtrSafe Function GetCommandLine Lib "kernel32" Alias "GetCommandLineW" () As LongLong
  Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
  Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#Else
    Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineW" () As Long
    Declare Function lstrlen Lib "kernel32" (ByVal lpString As string) As Long
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (MyDest As Any, MySource As Any, ByVal MySize As Long)
#End If

Public Function CmdLineToStr() As String
'Returns the whole command line used to open Excel:
    Dim Buffer() As Byte, StrLen As Long
    #If VBA7 Then
      Dim CmdPtr As LongLong
    #Else
      Dim CmdPtr As Long
    #End If
      
    CmdPtr = GetCommandLine()
    
    If CmdPtr > 0 Then
      #If VBA7 Then
        StrLen = lstrlen(CmdPtr) * 32
      #Else
        StrLen = lstrlen(CmdPtr) * 2
      #End If
      
      If StrLen > 0 Then
        ReDim Buffer(0 To (StrLen - 1)) As Byte
        CopyMemory Buffer(0), ByVal CmdPtr, StrLen

        CmdLineToStr = Buffer
      End If
    End If
End Function

Function ExtractArguments(strCmd As String) As String
 ExtractArguments = Mid(strCmd, InStr(strCmd, "/"))
End Function

Sub ProcessArguments(strArgs As String)
  If strArgs = "" Then Exit Sub
  Dim arr, ws As Worksheet, lastEmptyR As Long
  
  arr = Split(Trim(Mid(strArgs, InStrRev(strArgs, "/") + 1)), ",")
  
  If InStr(arr(UBound(arr)), Chr(0)) > 0 Then 'chr(0) is a kind of space added in command line...
        'replace what follows the last argument:
         arr(UBound(arr)) = Left(arr(UBound(arr)), InStr(arr(UBound(arr)), Chr(0)) - 1)
     ElseIf InStr(arr(UBound(arr)), " ") > 0 Then
        arr(UBound(arr)) = Left(arr(UBound(arr)), InStr(arr(UBound(arr)), " ") - 1)
     End If
  If arr(UBound(arr)) = "Date" Then arr(UBound(arr)) = Now 'replace Date with current tate (local format)
  
  Set ws = ThisWorkbook.Worksheets("Sheet1") 'use here the sheet you need
  lastEmptyR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row + 1     'determine the last empty cell in A:A
  ws.Range("A" & lastEmptyR).Resize(, UBound(arr) + 1).Value = arr 'drop the array content in A:C, on lastEmptyR
  ThisWorkbook.Save 'to also have the log of each workbook opening time...
End Sub

b. Insert the next code (auto Open event) inside ThisWorbook code module:

Option Explicit

Private Sub Workbook_Open()
  ProcessArguments ExtractArguments(CmdLineExtractString.CmdLineToStr)  'call the Sub processing arguments from
                                                                        'extracted command line used to open the workbook
End Sub

The arguments line in Task scheduler must look as:

"C:\File\Path\MyMacroEnabledFile.xlsm" /e/arg1,arg2,Date

2. Please, try the next VBScript (using WMI), able to find the Excel running process (if any), extract its command line and analyze it in the next way:

Option Explicit

'run the stript As Administrator. Otherwise, Windows considers `CommandLine` as a sensitive information
'to be extracted by any user, and raises an error. It needs UAC confirmation:
If Not WScript.Arguments.Named.Exists("elevate") Then
  CreateObject("Shell.Application").ShellExecute WScript.FullName _
    , """" & WScript.ScriptFullName & """ /elevate", "", "runas", 0
  WScript.Quit
End If

'All necessary declarations:
Dim strComputer, objwmiservice, colItems, objitem, strCmdLine, WbFullName, arr, strArgs
Const strWbName = "C:\Teste VBA Excel\Excel Open Command Line with Parametes.xlsm"

strComputer = "."
Set objwmiservice = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objwmiservice.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'Excel.exe'", , 48)
         
For Each objitem In colItems
    strCmdLine = objitem.CommandLine 'extract the process command line
    arr = Split(strCmdLine, """ """) 'place the string in an array separating between Excel path
                                     'and worbook to be open path
    
    WbFullName = Left(arr(1), InStr(arr(1), """ ") - 1) 'extract the workbook full name
    strArgs = Mid(arr(1), InStrRev(arr(1), "/") - 1)    'extract the arguments string
    If strWbName = WbFullName Then                      'if extracted name is the same with the necessary one
                                'kept in strWbName constant...
        Dim appExcel, ExWb, ws, lastR, wbName           'declarations to process the open workbook
        Set appExcel = GetObject(WbFullName).Application 'set Excel application using the pen workbook full name
        arr = Split(strWbName, "\")                      'split the full name by back slash ("\")
        wbName = arr(UBound(arr))                        'extract the workbook name, as the last in the array...
        Set ExWb = appExcel.Workbooks(wbName)            'set the workbook
        Set ws = ExWb.Worksheets(1) 'first worksheet of the workbook
                                    'use here the NECESSARY sheet
        lastR = ws.Range("A" & ws.Rows.Count).End(-4162).Row 'last row in A:A column of ws worksheets
        If CDate(Int(CDate(ws.Range("C" & lastR).Value))) = Date Then 'if extracted Date from the Date + time = current Date:
            DoSomething          'call this sub
        Else                                                          'if not:
            DoSomethingElse ExWb 'call this one, with the workbook object as parameter
        End If
    End If
Next

Sub DoSomething()
  'do what it is necessary
  MsgBox "Do something..."
End Sub

Sub DoSomethingElse(wb)
  'do what it is to be done, if the workbook date is NOT the current one
  MsgBox "Problem..."
  'wb.Close: wb.Parent.Quit 'if necessary
End Sub

As I suggested in one of my comments, a suitable way can be to programmatically change the existing task arguments. Please, see how a VBScript able to do it must look:

Option Explicit

'run the stript As Administrator:
If Not WScript.Arguments.Named.Exists("elevate") Then
  CreateObject("Shell.Application").ShellExecute WScript.FullName _
    , """" & WScript.ScriptFullName & """ /elevate", "", "runas", 0
  WScript.Quit
End If

Dim ts, rootFolder, Tasks, Task, colActions, objAction, strArguments, arr, existDate, modifArguments, newTaskDef
Const taskName = "Rulat Excel Workbook With Arguments" 'use here your task name

    Set ts = CreateObject("Schedule.Service"): ts.Connect
    
    Set rootFolder = ts.GetFolder("\") 'uncheck if the task is in the root folder
    'Set rootFolder = ts.GetFolder("\Your Folder") 'tasks in "Your Folder" sub-folder
    
    Set Tasks = rootFolder.GetTasks(0) 'all tasks in the chosen folder
    
    Set newTaskDef = ts.NewTask(0) 'new task definition, to receive the existing one definition
                                   'only in this way the actual task can be modified and registered!

    If Tasks.count = 0 Then
        MsgBox "No tasks are registered."
        Wscript.Quit
    Else
        set Task = rootFolder.getTask(taskName) 'set the task to be modified
        set newTaskDef = Task.Definition        'take the existing task definition!

        Set colActions = newTaskDef.Actions
          For Each objAction In colActions
              If objAction.Type = 0 Then
                  strArguments = objAction.Arguments 'place the arguments string in this variable
                  MsgBox "Existing arguments: " & vbcrlf & strArguments

                  arr = split(strArguments,",") 'split it by comma to use for processing
                  existDate = arr(Ubound(arr))  'last argument from arguments string...

              'just for testing... If it works, the current next day Date will be used:
                  modifArguments = replace(strArguments, mid(strArguments, len(strArguments) - len(existDate) + 1,len(existDate)), cStr(Date + 1))
          MsgBox "Arguments to be updated..." & vbcrlf & modifArguments

                  objAction.Arguments = modifArguments 'place the new arguments string in the the task

          Call rootFolder.RegisterTaskDefinition( _
                  Task.Name, newTaskDef, 4, , , 3) 'it updates The task with the new Date, as the last argument!!!
              End If
          Next
    End If

Please, send some feedback after testing it.