Move mouse

[Abraxus]

I am looking for a way to keep my screen saver from kicking on every 20 minutes.

I have an automation tool that is working doing work on my PC, but the screen saver still kicks on, and I'd like to prevent that.

I can't use 3rd party tools or turn off the screen saver due to corporate restrictions on what I can do with my PC, but I figured there might be a way to to trigger a mouse move with VBA and a timer in something like Access or Excel.

Any ideas or suggestions?

Thanks!

[HansV]

You could use the Poor Man's Mouse Jiggler...

Or you could copy the following code into a module in the Visual Basic Editor in any Office application:

Code: Select all

Private Const SPI_SETSCREENSAVEACTIVE = 17
 
Private Declare Function SystemParametersInfo Lib "user32" _
    Alias "SystemParametersInfoA" (ByVal uAction As Long, _
    ByVal uParam As Long, ByVal lpvParam As Long, _
    ByVal fuWinIni As Long) As Long
 
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

Sub ScreensaverOff()
    EnableScreenSaver False
End Sub

Sub ScreensaverOn()
    EnableScreenSaver True
End Sub

Run ScreensaverOff to disable the screensaver.

[Abraxus]

I was super excited to see the poor man's mouse jiggler, but it said the video wasn't there...

I tried your code, but my screensaver still kicked on.

I found & modified this code, which I think will work for me...

Code: Select all

Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Sub KeepAlive()
    While True 'Keep it running all the time
        MoveA 'Move it once
        Pause (600) 'Wait 10 minutes
        MoveB
        Pause (600) 'Wait 10 minutes
    Wend
End Sub

Sub MoveA()
    SetCursorPos 100, 100 'x and y position
End Sub

Sub MoveB()
    SetCursorPos 200, 200 'x and y position
End Sub

Public Function Pause(NumberOfSeconds As Variant)
On Error GoTo Err_Pause

    Dim PauseTime As Variant, start As Variant

    PauseTime = NumberOfSeconds
    start = Timer
    Do While Timer < start + PauseTime
    DoEvents
    Loop

Exit_Pause:
    Exit Function

Err_Pause:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "Pause()"
    Resume Exit_Pause

End Function

[HansV]

I have edited the link in my previous reply.

The code that I posted works for me, but that's on a computer without restrictions...

[ChrisGreaves]

... but that's on a computer without restrictions...

So is this :-

Code: Select all

Sub MoveA()
    SetCursorPos 1000 * Rnd(), 1000 * Rnd() 'x and y position
End Sub
Sub MoveB()
    SetCursorPos 1000 * Rnd(), 1000 * Rnd() 'x and y position
End Sub