a backup nightmare (may cause depression)

wigarth

Board Regular
Joined
Apr 16, 2016
Messages
51
Office Version
  1. 365
Platform
  1. Windows
I have a macro called "Savecopy" that keeps failing due to screensavers and power save mode... I cant wrap my head around this... please help.

The point of the macro is that the "Private Sub Workbook_Open()" needs to be refreshed. (It fails whenever screensaver, power saving modes sets in. And because administrators refusing us to change this, we need to make some Macgyver solutions to it.)

Private Sub Workbook_Open() have an ontime code that calles a macro called savecopy that backs up the workbook every hour on a network drive. It works fine untill screensaver og power saving mode becomes active. Then it makes the workbook read only and the given filename impossible to overwrite. "Error message is that the same name can not be used"

So to force a refresh to the Private Sub Workbook_Open() thingie I thought id force a close workbook and reopen it, but i need to save the file first...

my first idea was then to save a backupfile. Close it and reopen it, and then run the "Savecopy" Macro... But:
Somehow my excel also requires me to have an open workbook to be able to switch between books. i can't close thisworkbook, and then reopen it unless there is another workbook open. then excel just closes everything and have an empty window (The program itself doesn't close)

My Idea is then:

1: Save the current workbook as: L:\Skiftledere\Pallelister\Backup.xlsm (making it the active workbook)
2: Inside backup.xlsm there is a macro called "Savecopy" wich is to be excecuted. (This will save backup.xlsm as a new file depending on certain cells. Lets just call it "Newfile" as an example)
4: newfile should open backup.xlsm and close newfile
5: backup.xlsm should open newfile again (then forcing a refresh to Private Sub Workbook_Open())
6: Backup.xlsm should be closed and killed/deleted

But this project is beyond me... my coding here seems to stop with closing books and new ones not continuing the cript...

Is there an easier way? (There are some codes that run when workbooks are opened, maybee this is why my coding fails?)
any help appreciated, as of now I can't sleep... :-)
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
My first thought was that perhaps SendKeys (which I try to avoid for run of the mill coding) might help. A quick google search:

I just don't understand why more people don't do these searches :unsure:
 
Upvote 1
The following should work to stop the screensaver from activating & prevent sleep mode.

I used some @Jaafar Tribak code and added some code to handle the screensaver.

VBA Code:
Option Explicit
'
#If VBA7 Then
    Private Declare PtrSafe Function SetThreadExecutionState Lib "Kernel32.dll" _
            (ByVal esFlags As Long) As Long
    Private Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
            (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, _
            ByVal fuWinIni As Long) As Long
#Else
    Private Declare Function SetThreadExecutionState Lib "Kernel32.dll" _
            (ByVal esFlags As Long) As Long
    Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
            (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, _
            ByVal fuWinIni As Long) As Long
#End If

Private Const SPI_SETSCREENSAVEACTIVE = 17

Public Property Let PreventSleepMode(ByVal bPrevent As Boolean)
'
    Const ES_SYSTEM_REQUIRED As Long = &H1
    Const ES_DISPLAY_REQUIRED As Long = &H2
    Const ES_AWAYMODE_REQUIRED = &H40
    Const ES_CONTINUOUS As Long = &H80000000
'
    If bPrevent Then
        Call SetThreadExecutionState(ES_CONTINUOUS Or ES_DISPLAY_REQUIRED Or _
                ES_SYSTEM_REQUIRED Or ES_AWAYMODE_REQUIRED)
        Call EnableScreenSaver(False)
    Else
        Call SetThreadExecutionState(ES_CONTINUOUS)
        Call EnableScreenSaver(True)
    End If
End Property

 
Sub Main()
'
' Enable away mode and prevent the sleep idle time-out.
    PreventSleepMode = True
'
'
'
'   Put the code you want to run here ....
'
'
'
'Clear EXECUTION_STATE flags to disable away mode and allow the system to idle to sleep normally.
    PreventSleepMode = False
End Sub

 
Public Function EnableScreenSaver(ByVal bStatus As Boolean) As Boolean
'
    Dim lActiveFlag     As Long
    Dim lRetval         As Long
'
    lActiveFlag = IIf(bStatus, 1, 0)
    lRetval = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, lActiveFlag, 0, 0)
'
    If lRetval > 0 Then
        EnableScreenSaver = True
    Else
        EnableScreenSaver = False
    End If
End Function
 
Upvote 1
My first thought was that perhaps SendKeys (which I try to avoid for run of the mill coding) might help. A quick google search:

I just don't understand why more people don't do these searches :unsure:
Hi! thanks for the tip. I understand what you mean. It just never came to me to search for this simple solution. I got stuck in harder codes and focused entirely on that. Sometimes the solution is right in front of you and often also very simple. Thats the good thing about forums like this, that more ppl can have a look at the problem and provide simple, but yet genious tips. Not confirmed that it works yet, but so far it looks like a code of 4 lines have solved an issue i have been struggling with for weeks... I just got stuck and lost focus thats all. But thanks for clearing any obstacles and putting me back on the road. Really appreciate it. :)
 
Upvote 0
The following should work to stop the screensaver from activating & prevent sleep mode.

I used some @Jaafar Tribak code and added some code to handle the screensaver.

VBA Code:
Option Explicit
'
#If VBA7 Then
    Private Declare PtrSafe Function SetThreadExecutionState Lib "Kernel32.dll" _
            (ByVal esFlags As Long) As Long
    Private Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
            (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, _
            ByVal fuWinIni As Long) As Long
#Else
    Private Declare Function SetThreadExecutionState Lib "Kernel32.dll" _
            (ByVal esFlags As Long) As Long
    Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
            (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, _
            ByVal fuWinIni As Long) As Long
#End If

Private Const SPI_SETSCREENSAVEACTIVE = 17

Public Property Let PreventSleepMode(ByVal bPrevent As Boolean)
'
    Const ES_SYSTEM_REQUIRED As Long = &H1
    Const ES_DISPLAY_REQUIRED As Long = &H2
    Const ES_AWAYMODE_REQUIRED = &H40
    Const ES_CONTINUOUS As Long = &H80000000
'
    If bPrevent Then
        Call SetThreadExecutionState(ES_CONTINUOUS Or ES_DISPLAY_REQUIRED Or _
                ES_SYSTEM_REQUIRED Or ES_AWAYMODE_REQUIRED)
        Call EnableScreenSaver(False)
    Else
        Call SetThreadExecutionState(ES_CONTINUOUS)
        Call EnableScreenSaver(True)
    End If
End Property

 
Sub Main()
'
' Enable away mode and prevent the sleep idle time-out.
    PreventSleepMode = True
'
'
'
'   Put the code you want to run here ....
'
'
'
'Clear EXECUTION_STATE flags to disable away mode and allow the system to idle to sleep normally.
    PreventSleepMode = False
End Sub

 
Public Function EnableScreenSaver(ByVal bStatus As Boolean) As Boolean
'
    Dim lActiveFlag     As Long
    Dim lRetval         As Long
'
    lActiveFlag = IIf(bStatus, 1, 0)
    lRetval = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, lActiveFlag, 0, 0)
'
    If lRetval > 0 Then
        EnableScreenSaver = True
    Else
        EnableScreenSaver = False
    End If
End Function
Hi! Thanks for the tip, however it did nothing... Some of the code came out red in the editor. I used the "Sendkey" tip provided and so far it looks like it works easier. Still much appreciated though. Again: Many thanks!
 
Upvote 0
Some of the code came out red in the editor.
@wigarth, some of the code should come out red in the editor. It is testing whether you are on 32bit or 64bit Excel and making the declarations accordingly.

It will make the code red for whichever version you are not running.
It does not stop the code running

I am not saying the code works as I haven't tested it but the code being red if it is in the section below is not an issue

VBA Code:
#If VBA7 Then
    Private Declare PtrSafe Function SetThreadExecutionState Lib "Kernel32.dll" _
            (ByVal esFlags As Long) As Long
    Private Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
            (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, _
            ByVal fuWinIni As Long) As Long
#Else
    Private Declare Function SetThreadExecutionState Lib "Kernel32.dll" _
            (ByVal esFlags As Long) As Long
    Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
            (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, _
            ByVal fuWinIni As Long) As Long
#End If
 
Upvote 0
@wigarth couple of questions for you:

1) Did you add your code into the 'Main' section of the code? If you didn't add any code, the script I provided will 'appear' to do nothing.
2) Do you know at what time interval your screen is set to turn off?
3) Do you know at what time interval you screensaver is set to turn on?
4) Do you know at what time interval your computer is set to go into sleep mode?

I am asking because I tested the code I posted, prior to posting it, on 32bit Excel version & it did everything I said it would do.
 
Upvote 0

Forum statistics

Threads
1,223,910
Messages
6,175,316
Members
452,634
Latest member
cpostell

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top