Run a left mouse click in a loop until specific time is reached

Question

I am trying to run an infinite left button mouse click in a loop which should be broken when the time reaches specific value (i.e. specific hour). Left click should take place always in the same cell with 5 seconds intervals. I am using Windows 10 and Excel 2016.

I tried to compile some code but the timer function seems to be not working as well as the mouse click does not take place in the same cell. Any suggestions would be appreciated.

Public Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As LongPtr
Public Declare PtrSafe 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)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Timer()
Dim t As Date, tStop As Date

t = Now
tStop = t + TimeValue("19:43:00") 'Adjust the TimeValue as needed "hh:mm:ss"


Do Until t = tStop
DoEvents

  SetCursorPos 634, 371 'x and y position
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  Sleep 5000
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0


t = Now
Loop


MsgBox "t = " & t & vbCrLf & "tStop = " & tStop


End Sub

What is the purpose of that? You know [Application.OnTime](https://stackoverflow.com/questions/2319683/vba-macro-on-timer-style-to-run-code-every-set-number-of-seconds-i-e-120-secon)? — ComputerVersteher, Aug 28 '19 at 06:24

score 0 · Answer 1 · answered Aug 28 '19 at 00:59

It's going to be a rare event for this condition to be true:

Do Until t = tStop

Especially given you sleep for 5 seconds:

Sleep 5000

Instead check if its equal to or greater than:

Do Until t >= tStop

Tip: this code is hard to read and it would be self explanatory use the DateDiff function, eg:

Do Until secondCount >= 0
   secondCount = DateDiff("ss", dateToEnd, Now)

Run a left mouse click in a loop until specific time is reached

1 Answers1