If Minute(Time)=0 and Second(Time)<5 then 'условие проверки времени для вывода на экран вопроса о завершении своей работы
     ques=wssh.Popup("Не желаете завершить работу скрипта автопечати документов?"&vbCrLf&"Следующий запрос будет через час...",, "Скрипт автопечати | Lucky edited", 36)
     if ques=6 then WScript.Quit
     WScript.Sleep 5000
  End If

Dim t1
t1=timer
Do while (timer-t1)/3600 < 3

Option Explicit : Dim objWord, objDoc, wssh, objFS, objPath, objFolder, objItem, ques
Const wdDoNotSaveChanges    =  0
Const wdPromptToSaveChanges = -2
Const wdSaveChanges         = -1

Set wssh = CreateObject("WScript.Shell")
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objPath = objFS.GetFolder("d:\doc\") 'Папка, из которой производится печать

Do
  PrintDelInFolder objPath
  WScript.Sleep 1000
  If Minute(Time)=0 and Second(Time)<5 then 'условие проверки времени для вывода на экран вопроса о завершении своей работы
     ques=wssh.Popup("Не желаете завершить работу скрипта автопечати документов?"&vbCrLf&"Следующий запрос будет через час...",, "Скрипт автопечати | Lucky edited", 36)
     if ques=6 then WScript.Quit
     WScript.Sleep 5000
  End If
Loop

Sub PrintDelInFolder(objFolder)
    For Each objItem In objFolder.Files
        If StrComp(objFS.GetExtensionName(objItem.Name), "xls", vbTextCompare) = 0 Then
            With WScript.CreateObject("Excel.Application")
                Set objDoc = .Workbooks.Open(objItem.Path)
                objDoc.PrintOut
                .Quit
                Set objDoc = Nothing
                WScript.Sleep 500
                objFS.DeleteFile objItem.Path ',true 'если надо удалять и доки с атрибутом "Только чтение" - уберите символ ' перед true
            End With
        End If
    Next
End Sub

Set objWord = Nothing
WScript.Quit 0