VBA function running continuously in PowerPoint?

[mads husted]

Hello VBA experts

Im work on a ship in the north atlantic ocean, where we like all others are using satellite communication.
Its part of my job to keep it running, but unstable connection makes pople call my all the time. So on the televisions we have a PowerPoint running in loob with information.
I have a VBA that are displaying a figure off the internet status. Its change coloer if we loose the internet.

I can get it to run automatically when I open the PowerPoint by using a shortcut and add the text
"C:\Program Files (x86)\Microsoft Office\Office16\POWERPNT.EXE" /M "C:\InfoTV\Powerpoint figur internet status\Powerpoint status.pptm" "changedcolor

Hers the problem, its only run one time, how to make it to run continuously?

You can see my code and I have Attach my powerpoint.

In advanced thanks.

Sub changedcolor()
    Dim hshp As Shape
    Dim osld As Slide
    
    For Each osld In ActivePresentation.Slides
        For Each hshp In osld.Shapes
            With hshp
                If .Name Like "GoogleShape*" And IsConnected = True Then
                    .Fill.ForeColor.RGB = RGB(255, 255, 255)
                    .Fill.Solid
                ElseIf .Name Like "GoogleShape*" And IsConnected = False Then
                    .Fill.ForeColor.RGB = RGB(50, 50, 50)
                    .Fill.Solid
                End If
            End With
        Next hshp
    Next osld
End Sub


Public Function IsConnected()
    Dim objFS As Object
    Dim objShell As Object
    Dim objTempFile As Object
    Dim strLine As String
    Dim strFileName As String
    Dim strHostAddress As String
    Dim strTempFolder As String
    
    strTempFolder = "C:\PingTemp"
    strHostAddress = "8.8.4.4"
    IsConnected = True ' Assume success
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Wscript.Shell")
    
    If Dir(strTempFolder, vbDirectory) = "" Then
        MkDir strTempFolder
    End If
    
    strFileName = strTempFolder & "" & objFS.GetTempName
    If Dir(strFileName) <> "" Then
        objFS.DeleteFile (strFileName)
    End If
    
    objShell.Run "cmd /c ping " & strHostAddress & " -n 1 -w 1 > " & strFileName, 0, True
    Set objTempFile = objFS.OpenTextFile(strFileName, 1)
    Do While objTempFile.AtEndOfStream <> True
        strLine = objTempFile.Readline
        If InStr(1, UCase(strLine), "REQUEST TIMED OUT.") > 0 Or InStr(1, UCase(strLine), "COULD NOT FIND HOST") > 0 Then
            IsConnected = False
        End If
    Loop
    objTempFile.Close
    objFS.DeleteFile (strFileName)
    objFS.DeleteFolder (strTempFolder)
End Function