Public Declare Function GetForegroundWindow Lib "user32" _
() As Long '**
Public Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" (ByVal HWnd As Long, _
ByVal lpString As String, ByVal cch As Long) As Long '**
Sub ExcelL_20_12_2022()
'Macro L to Log Active Windows in Active Spreadsheet - CPU approx 14% - clear airflow for laptop!
'Macro l, version to log with Excel not open to be coded. May add tech break (20mins in middle of 4 hours and lunch prompts)
'SOURCE: jam61mar@gmail.com
'https://paypal.me/1ClickQAT?country.x=GB&locale.x=en_GB
'ScreenUpdating = False and True lower down, not needed
Range("A1") = "Macro L: Running"
Range("B1") = "<<< Delete text in Cell A1 to stop Macro L"
Range("B2") = "With Taskbar Settings set to <Never combine taskbar buttons> click on this Excel file on the Taskbar to set a marker if needed"
Range("B3") = "To Work in Excel >>>This file is Active Window >>>START >>>ALT+Excel >>>Do you want to start a new instance of Excel? >>>Yes"
Range("A5").Select 'personal macro record
'[single click execution via QAT]>> "- & down chevron" on QAT >>More Commands >>Popular Commands >>Macros >>Add >>Edit Macro L >>OK
Dim ExR As Range
Set ExR = Selection 'current location in Excel Spreadsheet*
'SOURCE*: https://www.appsloveworld.com/vba/100/5/extract-data-from-word-document-to-an-excel-spreadsheet
Dim PreText As String 'pre loop - personal insert
PreText = "aaaaaaaaaaaaaaaaaaaaa" 'just needed an active window text that is unlikely to occur
ExR(1, 1) = "Date and Time"
ExR(1, 2) = "Active Window"
Rows("6:6").Select 'personal macro record
ActiveWindow.FreezePanes = True
row = 2
Do While Range("A1") = "Macro L: Running"
'SOURCE**: https://answers.microsoft.com/en-us/msoffice/forum/all/window-handler-in-excel-vba/ccdee036-1755-4589-a79a-94f7b899b3f6
Dim WinText As String
Dim HWnd As Long
Dim L As Long
HWnd = GetForegroundWindow()
WinText = String(255, vbNullChar)
L = GetWindowText(HWnd, WinText, 255)
WinText = Left(WinText, InStr(1, WinText, vbNullChar) - 1)
'Debug.Print L, WinText **from the original code – line commented out, repurposed from www.cpearson.com at heart of this Macro L
If PreText = WinText Then
'Delay 0.3 Second and then GoTo SkipRetry
'***https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/timer-function
Dim PauseTime, Start, Finish, TotalTime
Dim StartTime As Single ', TimeElapsed As Single
Dim StartDate As Date
StartDate = Date
StartTime = Timer
PauseTime = 0.3
'SOURCE****: Overcome Midnight problem of Timer (can’t see code just to error handle pause straddle at 00:00:00)
'****https://excelbianalytics.com/wp/article-35-vba-timer-function-and-overcoming-midnight-limitation-of-timer-function/
Dim Adjust
Adjust = (86400 * (Date - StartDate)) - (StartTime * (Date - StartDate))
'Adjust calculates the PauseTime before the new day at 00:00:00, if the PauseTime straddles Midnight
'if PauseTime straddles Midnight:
'StartTime is reset to zero
'PauseTime is reset to delete PauseTime before Midnight
Do While Timer < _
(StartTime - (StartTime * (Date - StartDate))) + _ 'StartTime or zero for Midnight straddle
(PauseTime - (PauseTime * (Date - StartDate))) + _'PauseTime or
(PauseTime * (Date - StartDate)) – Adjust 'PauseTime from 00:00:00 only for Midnight straddle
'After a rare PauseTime straddle between two dates, the formula will revert back to the simple version:
'Do While Timer < StartTime + PauseTime