Code to create a pop-up window with a text field - entries should be logged in a sheet

[LJansen]

Hi Everyone,

Semi new to VBA code but always hopeful to learn something new.

At my previous company, we had a time management software that pop-up a window asking "What are you doing now?" but at the new place the IT security issues are so great (can't get assess to Task Manager) that they cant approve it. So I semi want to recreate this and though VBA macros would be the easiest and best option.

Please can someone help me get the code going to create a pop-up every 15minutes asking me what I am doing? The entries should be logged naturally with a date and time stamp.

I hope this is an easy thing to do - could find anything related to this so might be so easy that it never was an issue.

Thank you in advance.

 

[My Aswer Is This]

This would be a simple script. But I'm not sure how you get the program to do a Popup message every 15 minutes. That would require the program to be constantly looking to see what time it is now.
But maybe someone here will teach us both how to do that.

 

[Legacy 456155]

Interesting. Does it help you manage your time? I spent a bit more time on this then usual because I may use it though I'm thinking that it might get on my nerves. I don't know.

You may download an example if you wish: Activity Logger.xlsm in this folder. Let me know if you happen to have a 32 bit system. I did not bother accounting for 32 bits.

To create it yourself, add a userform with TextBox1 (MultiLine = True, EnterKeyBehavior = True) and CommandButton1.
Punch in the following code:

Option Explicit

Private Declare PtrSafe Function SetWindowPos Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongLong) As LongLong

Private Const HWND_TOPMOST = -1
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2

Private Const ShowOnTopOfOtherWindows As Boolean = True

Private Sub UserForm_Initialize()
    If ShowOnTopOfOtherWindows Then
        Dim UserFormHwnd As Long
        IUnknown_GetWindow Me, VarPtr(UserFormHwnd)
        SetWindowPos UserFormHwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
    End If
End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub UserForm_Terminate()
    If Len(Trim(TextBox1)) = 0 Then Exit Sub
    With Sheet1.ListObjects(1)
        With .ListRows.Add
            .Range(1) = Now
            .Range(2) = TextBox1
        End With
    End With
    ThisWorkbook.Save
End Sub

Much of the code above is to make the window show on top of all other windows. That might get aggravating, but what good is an activity logger if it doesn't demand attention? If, however, you don't want the form to pop up and interrupt you, change the assignment to the constant, ShowOnTopOfOtherWindows = False. In that case, the Excel icon will simply flash in the taskbar I suppose.

Throw this code in the workbook class:

Option Explicit

Private NextRunTime As Date

Private Sub Workbook_Open()
    LogAction
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopPoppingUp
End Sub

Public Sub LogAction()
    frmLogAction.Show vbModeless
    NextRunTime = Now + TimeSerial(0, 15, 0)
    Application.OnTime NextRunTime, "ThisWorkbook.LogAction"
End Sub

Private Sub StopPoppingUp()
    Application.OnTime NextRunTime, "ThisWorkbook.LogAction", , False
End Sub

There are some other things you might add such as rounding to the nearest 15 minute interval, showing multiple instances of the window if you miss one of your activity prompts, determing which monitor to show the form on, etc. If this thing has any chance of survival with me, it will be on monitor two.

 

[LJansen]

This exactly what i needed !!! Thank you so much it saved me some time.

 

[Legacy 456155]

Good. I am going to try this thing out. I do log my time in broad categories, but I do it in hindsight. If I find this useful and make any improvements, such as adding categories, I'll post here. For now, I did add rounding code to start/resume at the next 15 minute interval.

NextRunTime = Now + TimeSerial(0, 15 - Minute(Now) Mod 15, 0)