I think the code is now running past the shell command that is creating the file you are trying to open, this may be due to adding in the DoEvents.
Try the below, I have added in a 5 second wait after the shell command to allow it time to create the file before the code tries to open it.
I have edited it so it should run roughly every 30 seconds, this can be edited if you wish by changing the time in the first 'Wait'. Currently 25 seconds plus the 5 seconds for shell part makes a 30 second loop. If you make the first wait 55 seconds then it should loop roughly every 60 seconds etc..
Option Explicit
Sub changedcolor()
Dim ic As Boolean
Dim hshp As Shape
Dim osld As Slide
Do
ic = IsConnected
For Each osld In ActivePresentation.Slides
For Each hshp In osld.Shapes
With hshp
If .Name Like "GoogleShape*" And ic Then
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.Solid
ElseIf .Name Like "GoogleShape*" And Not ic Then
.Fill.ForeColor.RGB = RGB(50, 50, 50)
.Fill.Solid
End If
End With
Next hshp
Next osld
Wait (25)
Loop
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
Wait (5)
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
Function Wait(wt As Long)
Dim start As Long
start = Timer
While Timer < start + wt
DoEvents
Wend
End Function