Question: Macro to save and close workbook

[extremecorvette]

Question: Macro to save and close workbook
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
This is what I have come up with, I have found three issues with it.

• One it closes all the workbooks I have open and only saves the one that the macro is in.
• Two if I put this macro in more than one workbook I can’t have both open at the same time.
• Three I got the missage to come up You have 5 minutes to save before Excel closes. But if no one clicks that message the workbook stays open.

<o> </o>
Running Excel 2003 with Windows 7
<o> </o>
<o> </o>
Private Sub Workbook_Open()
<o> </o>
Dim Start, Finish, TotalTime, TotalTimeInMinutes, TimeInMinutes
Application.DisplayAlerts = True
TimeInMinutes = 600
If TimeInMinutes > 5 Then
TotalTimeInMinutes = (TimeInMinutes * 60) - (5 * 60)
Start = Timer
Do While Timer < Start + TotalTimeInMinutes
DoEvents
<?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-comffice:smarttags" /><st1lace w:st="on">Loop</st1lace>
Finish = Timer
TotalTime = Finish - Start
Application.DisplayAlerts = False
MsgBox "This file has been open for " & TotalTime / 60 & " minutes. You have 5 minutes to save before Excel closes."
End If
<o> </o>
Start = Timer
Do While Timer < Start + (5 * 60)
DoEvents
<st1lace w:st="on">Loop</st1lace>
Finish = Timer
TotalTime = Finish - Start
Application.DisplayAlerts = False
MsgBox "Excel will now close."
Application.Quit

ActiveWorkbook.Close True
' closes the active workbook and saves any changes
End Sub

<o> </o>

 

[NdNoviceHlp]

So what's it supposed to do? Dave

 

[extremecorvette]

The Macro will auto save and close the workbook after a set time period. See I have 600 minutes in there. When 5 min is left it will pop up a box saying You have 5 minutes to save before Excel closes. You have to click the box to get it to go away and get the timer to resume.

So what's it supposed to do? Dave

 

[exceliz]

i have been looking for something like this and pasted it into my module

.... where is the times displayed? im confused

thanks

 

[NdNoviceHlp]

It doesn't display the times... just the warning msgbox. Instead of the using the msgbox line of code, call this macro and the msgbox will disappear in 5 seconds. HTH. Dave

Sub MsgBox5sec()
Dim WsShell
Dim intText As Integer
Set WsShell = CreateObject("WScript.Shell")
intText = WsShell.Popup("You have 5 minutes to save before Excel closes!", _
                              5, "WARNING") '5 is seconds
Set WsShell = Nothing
End Sub

 

[extremecorvette]

When there is only 5 min left a message pops up.

 

[NdNoviceHlp]

Yes as per your code the msgbox shows at the 5 min mark. The msgbox disappears by itself after 5 seconds which seems to address your 3rd concern. Dave

 

[extremecorvette]

I set it up to run 2 min and then at 1 min give the warning. It would be nice to get the WsShell.Popup to stay open for 30 sec.

I still need to find a way to only close this one workbook and not all the others I have open. Any ideas?


Here is the code I'm using.

Private Sub Workbook_Open()
Dim Start, Finish, TotalTime, TotalTimeInMinutes, TimeInMinutes
Application.DisplayAlerts = True
TimeInMinutes = 2
If TimeInMinutes > 1 Then
TotalTimeInMinutes = (TimeInMinutes * 60) - (1 * 1)
   Start = Timer
   Do While Timer < Start + TotalTimeInMinutes
       DoEvents
   Loop
   Finish = Timer
   TotalTime = Finish - Start
   Application.DisplayAlerts = False
Dim WsShell
Dim intText As Integer
Set WsShell = CreateObject("WScript.Shell")
intText = WsShell.Popup("You have 1 minutes to save before Excel closes!", _
                              1, "WARNING") '60 is seconds
Set WsShell = Nothing
End If
Start = Timer
   Do While Timer < Start + (1 * 60)
       DoEvents
   Loop
   Finish = Timer
   TotalTime = Finish - Start
   Application.DisplayAlerts = False
   MsgBox "Excel will now close."
   Application.Quit
   
   ActiveWorkbook.Close True
' closes the active workbook and saves any changes
End Sub

 

[NdNoviceHlp]

intText = WsShell.Popup("You have 1 minutes to save before Excel closes!", _
                              30, "WARNING") '30 is seconds (msgbox timer)

Take out the application.quit and only use the activeworkbook.close. HTH. Dave

 

[extremecorvette]

Ok this code now works for closing just the workbook I want to close but its not auto saving any of the changes I made before closing.

Private Sub Workbook_Open()
Dim Start, Finish, TotalTime, TotalTimeInMinutes, TimeInMinutes
Application.DisplayAlerts = True
TimeInMinutes = 2
If TimeInMinutes > 1 Then
TotalTimeInMinutes = (TimeInMinutes * 60) - (1 * 1)
   Start = Timer
   Do While Timer < Start + TotalTimeInMinutes
       DoEvents
   Loop
   Finish = Timer
   TotalTime = Finish - Start
   Application.DisplayAlerts = False
Dim WsShell
Dim intText As Integer
Set WsShell = CreateObject("WScript.Shell")
intText = WsShell.Popup("You have 1 minutes to save before Excel closes!", _
                              30, "WARNING") '30 is seconds (msgbox timer)
Set WsShell = Nothing
End If
Start = Timer
   Do While Timer < Start + (1 * 60)
       DoEvents
   Loop
   Finish = Timer
   TotalTime = Finish - Start
   Application.DisplayAlerts = False
   MsgBox "Excel will now close."
   ActiveWorkbook.Close
   
   ActiveWorkbook.Close True
' closes the active workbook and saves any changes
End Sub