The next step of this would be further automation, so that the"button" gets pushed automatically, for example on a daily basis at a predetermined time.
One intuitive approach would be to invoke your code using an Auto Macro such as Workbook_Open, and then have Windows Task Scheduler open your workbook on schedule as required.
However, there is a catch here. Workbooks used for automated workflow are very often also used for ad-hoc manual tasks, or are simply opened to view some data, with no intention of performing any (re)calculations. Now your auto macro code would run every time the workbook is opened. If the automated workflow involves some data modification and/or email notification, you will have side effects very time you open your workbook just to see what is in there.
Worse still, if your workbook is on a shared drive, other used may stumble upon it by accident, triggering execution of the auto macros when they never expect it.
Of course, you could run two copies of your spreadsheet - one for automation and one for manual inquiries, naming the "automation" one something like "never_ever_open_this_manually.xlsm", but what happens in practice in such cases is that the two workbooks fall out of sync, and one of them is always out of date (or worse, they are both partially out of date).
A much more elegant solution would be for the auto macro to detect that the workbook was invoked by the Task Scheduler and not manually, and run the workflow only in this case.
After some probing and looking for inspiration I have come up with this solution:
Private Function IsScheduled() As Boolean ' Determine if the workbook was opened manually or as part of a Task Scheduler routine On Error GoTo Decided Dim Result As Boolean Result = True ' An invisible or programmatically started session is always assumed scheduled If Not Application.Visible Then GoTo Decided If Not Application.UserControl Then GoTo Decided Result = False ' A session with more that one workbooks is always assumed manual If Application.Workbooks.Count > 1 Then GoTo Decided ' otherwise assume scheduled task if the workbook name was supplied in the command line Dim wname As String, cmdline As String cmdline = UCase(Trim(GetCommandLine)): wname = UCase(Trim(ThisWorkbook.Name)) Result = InStr(cmdline, wname) > 0 Decided: IsScheduled = Result On Error GoTo 0 End Function Private Sub Workbook_Open() If Is Scheduled Then ' Run your automated workflow here End If End Sub
It basically relies on the discovery that if a workbook is started by the Task Scheduler, its command line would be
C:\Program Files\OFFICE##\Excel.exe v:\path_to_workbook\workbook.xlsm
whereas for most other scenarios of workbook opening (directly from Excel or from Windows Explorer) the command line would look like
C:\Program Files\OFFICE##\Excel.exe
or
C:\Program Files\OFFICE##\Excel.exe /dde
i.e. would not contain the workbook name (instead, it passes the workbook via DDE)To get to the command line, we need to implement the following API function (taken from here):
#If Win64 Then Private Declare PtrSafe Function GetCommandLineL Lib "kernel32" Alias "GetCommandLineA" () As LongPtr Private Declare PtrSafe Function lstrcpyL Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As LongPtr) As Long Private Declare PtrSafe Function lstrlenL Lib "kernel32" Alias "lstrlenA" (ByVal lpString As LongPtr) As Long #Else Private Declare Function GetCommandLineL Lib "kernel32" Alias "GetCommandLineA" () As Long Private Declare Function lstrcpyL Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long Private Declare Function lstrlenL Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long #End If Private Function GetCommandLine() As String GetCommandLine = "FAILED TO RETRIEVE" ' fallback value is case of error On Error GoTo Finally ' suppress errors Dim strReturn As String #If Win64 Then Dim lngPtr As LongPtr #Else Dim lngPtr As Long #End If Dim StringLength As Long 'Get the pointer to the commandline string lngPtr = GetCommandLineL 'get the length of the string (not including the terminating null character): StringLength = lstrlenL(lngPtr) 'initialize our string so it has enough characters including the null character: strReturn = String$(StringLength + 1, 0) 'copy the string we have a pointer to into our new string: lstrcpyL strReturn, lngPtr 'now strip off the null character at the end: GetCommandLine = Left$(strReturn, StringLength) Finally: On Error GoTo 0 End Function
Note the compiler directives to make the code 32/64-bit aware -- this is absolutely essential if the workbook resides on a shared drive in a network with mixed 32/64-bit Excel installation. Otherwise opening the workbook might crash the entire Excel session for random unsuspecting users.
BONUS: When debugging the automation routine I have stumbled upon some wonderful tools you can use to play a practical joke on your peers. Namely you can use Application.OnKey to override the function of a commonly used key (like, a letter or an arrow) to something totally bizarre, and wrap it into Application.OnTime to activate at some (possibly random) point in the future. Put it in your auto macro, like so:
and watch your colleagues of choice get delighted at the emphatic computer offering them to go home at the end of the working day because they are tired and have worked long hours and it's late outside (I've borrowed the sleep function sov() from here). The code is very hard to detect because it executes totally silently and persists even after the workbook containing has long been closed; the empathy will last until Excel is closed or restarted -- but in most industry workplaces I have seen, this only happens when it crashes.
Public num As Integer Function sov(sekunder As Double) As Double starting_time = Timer Do DoEvents Loop Until (Timer - starting_time) >= sekunder End Function Sub GetDizzy() num = num + 1 On Error Resume Next Select Case (num Mod 5) Case 2 'move to opposite drection ActiveCell.Offset(0, 1).Select Case 3 'shake the workbook dx = Round(Rnd * 10) - 5: dy = Round(Rnd * 10) - 5 For i = 1 To 3 ActiveWindow.SmallScroll toright:=dx, down:=dy: sov (50 / 1000) ActiveWindow.SmallScroll toleft:=dx, up:=dy: sov (50 / 1000) Next i Case 4 'nudge the workbook ActiveCell.ColumnWidth = ActiveCell.ColumnWidth + Round(Rnd * 15) - 7 Case Else 'normal operation ActiveCell.Offset(0, -1).Select End Select If num > 200 Then MsgBox "You are tired and dizzy... Why don't you call it a day and go home?" On Error GoTo 0 End Sub Sub Payload() Application.OnKey "{LEFT}", "GetDizzy" End Sub Private Sub Workbook_Open() Application.OnTime Now + TimeValue("8:00:00"), "Payload" End Sub
and watch your colleagues of choice get delighted at the emphatic computer offering them to go home at the end of the working day because they are tired and have worked long hours and it's late outside (I've borrowed the sleep function sov() from here). The code is very hard to detect because it executes totally silently and persists even after the workbook containing has long been closed; the empathy will last until Excel is closed or restarted -- but in most industry workplaces I have seen, this only happens when it crashes.
No comments:
Post a Comment