проблема с прерыванием пакетного файла, запущенного с помощью VBA

#vba #batch-file

#vba #пакетный файл

Вопрос:

У меня есть файл Excel с большим количеством имен ПК на сервере, я хочу выполнить команду «systeminfo» и извлечь из нее операционную систему. Затем операционная система должна быть автоматически помещена в ячейку Excel. Для этого я использовал следующие коды, соответственно в файле VBA и в пакетном файле. однако, всякий раз, когда сервер не может подключиться к ПК, окно cmd зависает, пока я не закрою его вручную. Поскольку список на самом деле состоит из 148 имен, знание способа автоматического закрытия этих окон, скажем, через 8 секунд, было бы действительно полезным.

Я попытался найти способ многопоточного VBA, просто чтобы выяснить, что это однопоточный язык. Затем я попытался запустить другой пакетный файл с тем, который я на самом деле использую, чтобы принудительно убить его после определенного времени, но, похоже, что второй пакет запускается только после завершения первого, что делает его бесполезным.

VBA

 Sub Test()

' 
' Test Macro
' I'm not an expert in VBA, I just picked it up for this task, so a lot of code will result redundant. Bear with me
'
'
    Dim i As Integer
    'a is basically i-1. 
    a = 1

    ' I needed 148 cells for the project
    Dim models(1 To 147) As String
    For i = 2 To 148
        models(a) = Cells(i, 3).Value
        a = a   1
    Next i

    a = 1
    For i = 2 To 148

       'not totally sure what the next five lines actually do, but "metodo" is the name of the batch file.

        Dim strShellCommand As String
        strShellCommand = "C:UsersAdministratorDesktopmetodo.bat "   models(a)

        Set oSh = CreateObject("WScript.Shell")
        Set oEx = oSh.Exec(strShellCommand)

        strBuf = oEx.StdOut.readAll

        'I took out of the string everything that wasn't purely the OS name

        Dim FinalString As String
        FinalString = Right(strBuf, 26)
        FinalString = Left(FinalString, 25)

        'this is the line that prints the OS names into Excel cells

        ActiveSheet.Cells(i, 10) = FinalString

        a = a   1
    Next i     

End Sub
  

затем есть пакетный файл

  set nome=%1
 shift
 systeminfo /s %nome% |findstr /c:"Microsoft Windows "
  

Комментарии:

1. Я не вижу никакой пользы в том, чтобы делать это таким образом, что мешает вам сделать это непосредственно из VBA, используя GetObject("winmgmts:{impersonationLevel=impersonate}!\.rootcimv2").ExecQuery("SELECT Caption FROM Win32_OperatingSystem") ?

2. Вместо запуска пакетного файла я бы попытался выполнить systeminfo напрямую или следовать совету Compo…

Ответ №1:

вы можете выполнить цикл управления после установки oEx = oSh.Exec(strShellCommand)

Нравится :

  Set oEx = oSh.Exec(strShellCommand)
 LoopCount = 0
 Do 'Control loop
    wscript.Sleep 1000
   If TimeOut > 0 Then LoopCount = LoopCount   1
  Loop Until (oEx.Status <> 0) Or (LoopCount > TimeOut * 8)
  If oEx.Status = 0 Then 'Timeout occured
    oEx.Terminate 
    ReturnValue = "[Process terminated after timeout!]" amp; VbCrLf 
  Else
    ReturnValue = "[Process completed]" amp; VbCrLf  
  End If
  

каждый цикл занимает 1 секунду (wscript.Режим ожидания 1000) и (loopCount > TimeOut * 8) устанавливает общее время равным 8 секундам

удачи