Sleep / wait timer in PowerPoint VBA that's not CPU intensive

Question

I'm currently having a PowerPoint presentation that's being used on a computer as some sort of kiosk or information screen. It reads it's text from a text file on the disk. The text in this text file is displayed in a textbox in PowerPoint and this is being refresh every 5 seconds. This way we can edit the text in the PowerPoint without editing the PowerPoint presentation itself so it will continue to run. Work great so far, only PowerPoint VBA does not contain the Application.Wait function. See here the full sub:

Sub Update_textBox_Inhoud()

Dim FileName As String
TextFileName = "C:\paht\to\textfile.txt"
If Dir$(FileName) <> "" Then

Application.Presentations(1).SlideShowSettings.Run
Application.WindowState = ppWindowMinimized


While True


    Dim strFilename As String: strFilename = TextFileName
    Dim strFileContent As String
    Dim iFile As Integer: iFile = FreeFile
    Open strFilename For Input As #iFile
    strFileContent = Input(LOF(iFile), iFile)
    Application.Presentations(1).Slides(1).Shapes.Range(Array("textBox_Inhoud")).TextFrame.TextRange = strFileContent
    Close #iFile


    waitTime = 5
    Start = Timer
    While Timer < Start + waitTime
        DoEvents
    Wend

Wend

Else

End If
End Sub

As you can see I've got a loop within a loop to create a 5 second sleep / wait function, as PowerPoint doesn't have a Application.Wait function.

While running this macro my CPU load on my 7th gen i5 goes up to 36%. The kiosk computer has slightly worse hardware so the CPU load will be quite high and the fan of this PC will make a lot of noise.

I think the sleep / wait function doesn't really "sleep", it just continues to loop until 5 seconds have past.

Question 1 : Is my assumption that the function doesn't really sleep true? Question 2 : If the answer to question 1 is true, is there a better, less CPU intensive way, to create a sleep function?

Answer 1

To wait for a specific amount of time, call WaitMessage followed by DoEvents in a loop. It's not CPU intensive and the UI will remain responsive:

Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long


Public Sub Wait(Seconds As Double)
    Dim endtime As Double
    endtime = DateTime.Timer + Seconds
    Do
        WaitMessage
        DoEvents
    Loop While DateTime.Timer < endtime
End Sub