Code to close and reopen Excel after a set time- Is it feasible ?

[Jaafar Tribak]

I'm enquiring about this just out of intellectual curiosity . Any thoughts ?

Regards.

 

[John_w]

ZVI, your code didn't quite work for me either. It creates the scheduled task, but when that is run a Windows Script Host window appears with the error 'There is no script engine for file extension ".vbs".'

The fix is to specify wscript //e:vbscript in the command to tell the task scheduler to use the vbscript engine:

  Dim sCmd As String
  sCmd = "AT " & Format(Now + TimeSerial(0, 1, 0), "hh:mm") & " /INTERACTIVE wscript //e:vbscript """ & vbsFileName & """"
  Shell sCmd

 

[ZVI]

ZVI, your code didn't quite work for me either. It creates the scheduled task, but when that is run a Windows Script Host window appears with the error 'There is no script engine for file extension ".vbs".'

The fix is to specify wscript //e:vbscript in the command to tell the task scheduler to use the vbscript engine:

  Dim sCmd As String
  sCmd = "AT " & Format(Now + TimeSerial(0, 1, 0), "hh:mm") & " /INTERACTIVE wscript //e:vbscript """ & vbsFileName & """"
  Shell sCmd

Thank you John!

Both variants are working for me, but yours seems to be more universal.
How to fix such error is described here: There is no script engine for file extension ".vbs"

Regards,
Vladimir

 

[Jaafar Tribak]

The thing with using Scripting/Task-Scheduler is that it doesn' work if one has no user permission which is the case at work.

Regards.

 

[ZVI]

The thing with using Scripting/Task-Scheduler is that it doesn' work if one has no user permission which is the case at work.

Regards.

VBScript engine usualy is not blocked by administrator as it's commonly used.
So. you can try Tushar' suggestion on using Sleep without scheduling service :

<font face=Courier New>
' Reloading workbook itself with delay by the aid of WScript.Sleep
Sub ReloadExcel()
  
  Const Seconds = 10  ' <- delay in seconds
  Dim xlFileName$, vbsFileName$, vbsText$, FileNo%, Wb
  
  ' Define reloading file
  xlFileName = ThisWorkbook.FullName
  vbsFileName = Replace(LCase(xlFileName), ".xls", ".vbs")
  
  ' Build the text of VB script
  vbsText = "WScript.Sleep(" & Seconds * 1000 & ")" & vbLf _
          & "With CreateObject(""Excel.Application"")" & vbLf _
          & ".Visible = True" & vbLf _
          & ".Workbooks.Open (""" & xlFileName & """)" & vbLf _
          & ".Application.Run ""MyMacro""" & vbLf _
          & "End With"
  
  ' Create VBS file
  On Error Resume Next
  Kill vbsFileName
  FileNo = FreeFile
  Open vbsFileName For Binary Access Write As #FileNo
  Put #FileNo, , vbsText
  Close #FileNo
  
  ' Run VB script file
  Shell "wscript //e:vbscript """ & vbsFileName & """"
  
  ' Close all workbooks and quit
  'For Each Wb In Application.Workbooks: Wb.Close:  Next
  'Application.Quit
  
End Sub

' Macro for calling from VBS
Sub MyMacro()
  MsgBox "Hi from " & Application.UserName & "!"
End Sub</FONT>

 

[Jaafar Tribak]

Vladimir- That's awsome !

I didn't know about this WScript.Sleep Method and i'm sorry i misunderstood Tushar's suggestion to use it.

I ran this on my home pc and it worked like a charm. Let me now see if this also works on my pc at work where scripting is disabled by our IT adm.

Again thanks for your help and thanks to Tushar and yourself for teaching me something new.

Regards.

 

[Jaafar Tribak]

Ok. finally I hope I have arrived at what seems to be a stable and self-contained code that closes and reloads excel after a set time.

No VBScripting or Windows task-scheduler required with this one . only excel/vba used.

here is a workbook demo.

Code in a Standard Module (Main)

Option Explicit
 
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
 
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
 
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private lApphwnd As Long
 
Sub ReStartExcel(When As Date)
 
    Const CLOSE_MSG As String = "ATTENTION !!!" & vbCrLf _
    & vbCrLf & "Excel is about to close." _
    & vbCrLf & "Save your work now."
 
    Dim oNewApp As Application
    Dim oWB As Workbook
    On Error Resume Next
    SaveSetting _
    "ThisWorkBook", "FullName", "Value", CStr(ThisWorkbook.FullName)
    SaveSetting "Now", "Time", "Time", Time
    SaveSetting "ReOpen", "Time", "When", When
 
    ThisWorkbook.SaveCopyAs Environ("Temp") & "\Temp.xls"
    ThisWorkbook.Saved = True
 
    MsgBox CLOSE_MSG, vbExclamation
    For Each oWB In Application.Workbooks
        If Not oWB Is ThisWorkbook Then
            oWB.Close
        End If
    Next
 
    For Each oWB In Application.Workbooks
        If Not oWB Is ThisWorkbook Then
            oWB.Close False
        End If
    Next
 
    Set oNewApp = New Application
    oNewApp.Visible = False
    oNewApp.Workbooks.Open Environ("Temp") & "\Temp.xls"
    Application.Quit
 
End Sub
 
Private Sub TimerProc _
(ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
 
    Dim sThisWbkName As String
    Dim oNewApp As Application
 
    KillTimer lApphwnd, 0
    sThisWbkName = _
    (GetSetting("ThisWorkBook", "FullName", "Value"))
    Set oNewApp = New Application
    oNewApp.Visible = True
    oNewApp.Workbooks.Open sThisWbkName
    ThisWorkbook.ChangeFileAccess xlReadOnly
    Kill ThisWorkbook.FullName
    Application.Quit
 
End Sub
 
Sub Open_Routine()
 
    Const ERR_MSG As String = "An error has ocurred !" _
    & vbCrLf & "Make sure you passed a correct argument to the" _
    & vbCrLf & "'ReStartExcel' routine."
 
    Dim dWhen As Date
    Dim dTime As Date
 
    On Error GoTo errHandler
 
    Select Case True
 
        Case ThisWorkbook.Name = "Temp.xls"
            dWhen = (GetSetting("ReOpen", "Time", "When"))
            dTime = (GetSetting("Now", "Time", "Time"))
            DeleteSetting "ReOpen", "Time"
            DeleteSetting "Now", "Time"
            lApphwnd = FindWindow("XLMAIN", Application.Caption)
            SetTimer lApphwnd, 0, _
            DateDiff("s", dTime, dWhen) * 1000, AddressOf TimerProc
 
        Case ThisWorkbook.FullName = _
            (GetSetting("ThisWorkBook", "FullName", "Value"))
            DeleteSetting "ThisWorkBook", "FullName"
            MsgBox "Welcome back " & Application.UserName & "."
 
    End Select
 
    Exit Sub
 
errHandler:
    If ThisWorkbook.Name Like "Temp*" Then
        KillTimer lApphwnd, 0
        MsgBox ERR_MSG, vbCritical
        DeleteSetting "ThisWorkBook", "FullName"
        ThisWorkbook.ChangeFileAccess xlReadOnly
        Kill ThisWorkbook.FullName
        Application.Quit
    End If
 
End Sub

Code in the workbook class module :

Option Explicit
 
Private Sub Workbook_Open()
 
    Call Open_Routine
 
End Sub

This is an example of how to close and reload Excel in 5 seconds from now :

Option Explicit
 
Sub Test()
 
    [COLOR=seagreen]'Close Excel and reopen it in 5 seconds from now.[/COLOR]
    ReStartExcel When:=Time + TimeSerial(0, 0, 5)
 
End Sub

Baically, the code works by creating an invisible temporary copy of the workbook and reloading excel friom it via a windows timer .The register is used to temporarly store the workbook path.

Regards.

 

[tusharm]

I am sure you have a reason for this approach but given that you are closing all workbooks and quitting the application, my instinct would be to simply make the application not visible for however long you want to hide it.

If you must use another instance of Excel, consider putting the information you want to transfer to it in the temp workbook (rather than the registry).

And, of course, the OnTime method is always available.

Ok. finally I hope I have arrived at what seems to be a stable and self-contained code that closes and reloads excel after a set time.

No VBScripting or Windows task-scheduler required with this one . only excel/vba used.

here is a workbook demo.

Code in a Standard Module (Main)

Option Explicit
 
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
 
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
 
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private lApphwnd As Long
 
Sub ReStartExcel(When As Date)
 
    Const CLOSE_MSG As String = "ATTENTION !!!" & vbCrLf _
    & vbCrLf & "Excel is about to close." _
    & vbCrLf & "Save your work now."
 
    Dim oNewApp As Application
    Dim oWB As Workbook
    On Error Resume Next
    SaveSetting _
    "ThisWorkBook", "FullName", "Value", CStr(ThisWorkbook.FullName)
    SaveSetting "Now", "Time", "Time", Time
    SaveSetting "ReOpen", "Time", "When", When
 
    ThisWorkbook.SaveCopyAs Environ("Temp") & "\Temp.xls"
    ThisWorkbook.Saved = True
 
    MsgBox CLOSE_MSG, vbExclamation
    For Each oWB In Application.Workbooks
        If Not oWB Is ThisWorkbook Then
            oWB.Close
        End If
    Next
 
    For Each oWB In Application.Workbooks
        If Not oWB Is ThisWorkbook Then
            oWB.Close False
        End If
    Next
 
    Set oNewApp = New Application
    oNewApp.Visible = False
    oNewApp.Workbooks.Open Environ("Temp") & "\Temp.xls"
    Application.Quit
 
End Sub
 
Private Sub TimerProc _
(ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
 
    Dim sThisWbkName As String
    Dim oNewApp As Application
 
    KillTimer lApphwnd, 0
    sThisWbkName = _
    (GetSetting("ThisWorkBook", "FullName", "Value"))
    Set oNewApp = New Application
    oNewApp.Visible = True
    oNewApp.Workbooks.Open sThisWbkName
    ThisWorkbook.ChangeFileAccess xlReadOnly
    Kill ThisWorkbook.FullName
    Application.Quit
 
End Sub
 
Sub Open_Routine()
 
    Const ERR_MSG As String = "An error has ocurred !" _
    & vbCrLf & "Make sure you passed a correct argument to the" _
    & vbCrLf & "'ReStartExcel' routine."
 
    Dim dWhen As Date
    Dim dTime As Date
 
    On Error GoTo errHandler
 
    Select Case True
 
        Case ThisWorkbook.Name = "Temp.xls"
            dWhen = (GetSetting("ReOpen", "Time", "When"))
            dTime = (GetSetting("Now", "Time", "Time"))
            DeleteSetting "ReOpen", "Time"
            DeleteSetting "Now", "Time"
            lApphwnd = FindWindow("XLMAIN", Application.Caption)
            SetTimer lApphwnd, 0, _
            DateDiff("s", dTime, dWhen) * 1000, AddressOf TimerProc
 
        Case ThisWorkbook.FullName = _
            (GetSetting("ThisWorkBook", "FullName", "Value"))
            DeleteSetting "ThisWorkBook", "FullName"
            MsgBox "Welcome back " & Application.UserName & "."
 
    End Select
 
    Exit Sub
 
errHandler:
    If ThisWorkbook.Name Like "Temp*" Then
        KillTimer lApphwnd, 0
        MsgBox ERR_MSG, vbCritical
        DeleteSetting "ThisWorkBook", "FullName"
        ThisWorkbook.ChangeFileAccess xlReadOnly
        Kill ThisWorkbook.FullName
        Application.Quit
    End If
 
End Sub

Code in the workbook class module :

Option Explicit
 
Private Sub Workbook_Open()
 
    Call Open_Routine
 
End Sub

This is an example of how to close and reload Excel in 5 seconds from now :

Option Explicit
 
Sub Test()
 
    [COLOR=seagreen]'Close Excel and reopen it in 5 seconds from now.[/COLOR]
    ReStartExcel When:=Time + TimeSerial(0, 0, 5)
 
End Sub

Baically, the code works by creating an invisible temporary copy of the workbook and reloading excel friom it via a windows timer .The register is used to temporarly store the workbook path.

Regards.

 

[John_w]

Thank you John!

Both variants are working for me, but yours seems to be more universal.
How to fix such error is described here: There is no script engine for file extension ".vbs"

Regards,
Vladimir

The error There is no script engine for file extension ".vbs" occurred only when Task Scheduler ran the .vbs file. When run directly (by double-clicking it or from a command window) it runs successfully.

 

[Jaafar Tribak]

I am sure you have a reason for this approach but given that you are closing all workbooks and quitting the application, my instinct would be to simply make the application not visible for however long you want to hide it.

The reason behind this approach was nothing but a pretext to excercise some mental gymnastics and learn something new

If you must use another instance of Excel, consider putting the information you want to transfer to it in the temp workbook (rather than the registry).

Good point Tushar.- I might just as well have used the temp workbook to store the info needed like in some Cells or Workbook Names - Never occurred to me !

And, of course, the OnTime method is always available

As for using the built-in OnTime Method rather than a Windows Timer, I tried that but for some obscure reason didn't work as expected .

As usual, thanks for your valuable suggestions and for following this up.

Regards.