[Loran_rus]

попробовал Ваш скрипт, поставил WScript.Sleep 6000 он запускается 2 раза в подряд отрабатывает и все

сильно изменяюсь действительно вставил из буфера еще сырую версию

вот полностью рабочая

Код:

Set objShell = WScript.CreateObject("WScript.Shell")
Call Main
Private Sub Main
Set objExecObject = objShell.Exec("Cmd /c ping -n 5 www.ya.ru")
Do While Not objExecObject.StdOut.AtEndOfStream
	strText = objExecObject.StdOut.ReadLine()
	If Instr(strText, "(100% ") > 0 Then
		objResult = objShell.Run ("Cmd /c Echo 111 >Com3" , 0, True)
		Call WaitTime
	End If
Loop
End Sub
Call WaitTime
Private Sub WaitTime
WScript.Sleep 600000	'время = 10мин * 60сек * 1000
Call Main
End Sub

возможно ли чтоб как нибудь отображался процесс его работы??

Замените objResult = objShell.Run ("Cmd /c Echo 111 >Com3" , 0, True) на запуск приложения или открытие документа, ну или целиком строку.
Если желаете посмотреть работу команды пинг вот тот же скрипт с записью в

текстовый файл

Код:

Dim fso, f1, ts
Const ForWriting = 2
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateTextFile ("pingtest.txt")
Set f1 = fso.GetFile("pingtest.txt")
Set ts = f1.OpenAsTextStream(ForWriting, True)

Set objShell = WScript.CreateObject("WScript.Shell")
Call Main
Private Sub Main
Set objExecObject = objShell.Exec("Cmd /c ping -n 5 www.ya.ru")
Do While Not objExecObject.StdOut.AtEndOfStream
	strText = objExecObject.StdOut.ReadLine()
ts.WriteLine strText
	If Instr(strText, "(100% ") > 0 Then
		objResult = objShell.Run ("Cmd /c Cmd /c Echo 111 >Com3" , 0, True)
		Call WaitTime
	End If
Loop
ts.Close
End Sub
Call WaitTime
Private Sub WaitTime
WScript.Sleep 600000	'время = 10мин * 60сек * 1000
Call Main
End Sub