VBA Message Box Timer

[David Jenkins]

Hi All.

I have been working on automated report and I was using.

Sub Workbook_Open()

       ActiveWorkbook.RefreshAll
       ActiveWorkbook.Save
       ActiveWorkbook.Close 

End Sub

The problem with this is, it doesn't give me a chance to do anything with the workbook if I want to make changes.

What I was thinking if there was someway to call on a Sub after the save that would call a Msgbox that has a counter in it (lets say five minutes) at the end of the count down the workbook would just close itself, or if i clicked a button it would stop the countdown and not close the workbook?

I saw an old addin for something similar but I dont want to start putting addins into my workbook.

D.

 

[Deepak]

Try this without any timer..

Sub Workbook_Open()
Dim Q As Variant
ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
Q = MsgBox("Do you wish to make changes.", vbQuestion + vbYesNo, "Confirmation")
    If Q <> vbYes Then ActiveWorkbook.Close
End Sub

 

[Deepak]

& with timer.......
First make a backup of workbook or try this in a sample file.

Option Explicit

Private Sub Workbook_Open()
Dim Start As Long, Finish As Long, mysec As Integer, Q As Variant
Dim opentime As Long

With ThisWorkbook
    .RefreshAll
    .Save

mysec = 30 'Do the changes in seconds
opentime = mysec
100:
   Start = Timer
   Do While Timer < Start + mysec
       DoEvents
   Loop
   Finish = Timer
   
   Q = MsgBox("This file is open since last " & opentime / 60 & " minutes." & vbNewLine & _
    "Press Yes to Close, No to Remain open with timer" & vbnewline & "Cancel to Stop the timer", _
        vbQuestion + vbYesNoCancel)
    Select Case Q
        Case vbYes
            .Close True
        Case vbNo
            opentime = opentime + mysec
            GoTo 100
    End Select
End With
End Sub

 

[David Jenkins]

Hi Deepak,

Thank you for your response above and apologies for the delay in responding as I've been busy over the weekend.

Its almost there but i think that I may explained myself wrong!

I want the timer to automatically start when the MSGBOX appears and if there is no interaction then the sheet automatically closes. If there is an interaction then the timer can be stopped and the sheet doesn't close.

Regards,

Dave.

 

[Deepak]

Is this what you are looking for!!!

Private Sub Workbook_Open()
With ThisWorkbook
    .RefreshAll
    .Save
End With
    Dim mysec As Integer, msg As String
    mysec = 5 'Seconds
    msg = "This Workbook would close in " & mysec & _
        " seconds." & vbLf & "Press ok to terminate the timer."

    With CreateObject("WScript.Shell")
        Select Case .Popup(msg, mysec, "Info", 0)
            Case 1
                Exit Sub
        End Select
    End With
ThisWorkbook.Close True
End Sub

 

[David Jenkins]

Hi Deepak,

Thank you again. I think its nearly there. I think that the message is being displayed a split second too soon.

I can see the gold / yellow box when excel launches, it goes through the data connections dialog, does everything, gets to save 100% and then stays there because the MSGBOX has appeared. Anyway of delaying the MSGBOX appearing?

Thank you

 

[Deepak]

Hi,

I failed to understand what actually you are looking for as you forced me to get confused in this loop.

Pls check it in up heal order & let me know...

1.Excel open
2.Refresh All Data Connection
3.Save itself
4. A popup for 5 sec.
5. If no intersection made with popup then xl will close itself.

Now, let me know where i am wrong.

 

[shrivallabha]

You could try one thing.

Put the code inside Workbook Open event in the standard module:

Public Sub OpenWkbkEvent()
With ThisWorkbook
    .RefreshAll
    .Save
End With
    Dim mysec As Integer, msg As String
    mysec = 5 'Seconds    msg = "This Workbook would close in " & mysec & _
        " seconds." & vbLf & "Press ok to terminate the timer."

    With CreateObject("WScript.Shell")
        Select Case .Popup(msg, mysec, "Info", 0)
            Case 1
                Exit Sub
        End Select
    End With
ThisWorkbook.Close True
End Sub

And then in the main workbook_open event code simply put:

Private Sub Workbook_Open()
Application.Ontime Now(), "OpenWkbkEvent"
End Sub

And see if it works for you.

 

[David Jenkins]

Hi Both

Thank you - you are both

Moving it into the standard module stopped the vba getting stuck whilst saving. It works a treat. This is fantastic code as it'll be re-used time and time again!

Regards,

Dave.