VBA脚本从excel列表运行批处理文件，读取结果文件，解析结果文件并将结果写入主excel文件

Question

所以，在我放置我的代码之前，我会解释我想要做什么，因为我不能自己测试脚本，因为它应该做什么，影响它必须做什么。我知道这有点奇怪，但请多多包涵。

每两周左右一次，我们目前运行批处理文件以更新我们组织中所有 WS 上的特定工具。

是的，我们确实有工具传播软件，但由于这个特定的工具非常重要，我们不相信它会分发给任何自动化方法，这些方法在大多数情况下都被证明会在我们无法理解原因的情况下失败。

所以，我写了一些简单的命令批处理文件来运行安装命令，并将输出写入一个文本文件，然后我们手动查看它安装在哪个 ws 上，哪个没有安装。

未安装它的 ws 是我们知道由于故障而知道的 ws，我们遇到了其他问题，然后我们全力以赴查找和修复这些问题。

如你所想，这是一项耗时的工作，我决定尽可能地自动化手动检查，以便快速了解哪个 ws 失败，以及失败代码。

我从 excel 中的 ws 名称列表开始。

例如，

K190ASSn1.domainname
m930eastgate.domainname
n190alka.domainname
n190amsv.domainname
n190amzi.domainname
N190ARME.domainname
N190AVMA.domainname
N190AVNT.domainname
n190chockstest.domainname
N190DLCR.domainname
N190DNBS.domainname
N190edsh.domainname
n190ehma2.domainname
N190EISH.domainname

我编写脚本来执行以下操作：

1. 将 A 列中的所有 ws 名称读入一个数组。
2. 遍历数组，并使用Shell函数调用外部cmd文件，然后运行，并将运行结果写入位于D盘上名为“Minstall”的目录中的TXT文件。
3. 然后我将在该目录中创建的所有文件的名称读入一个新数组。
4. 我将两个数组从 A 到 Z 排序（使用我在网上找到的脚本）以使下一阶段的所有内容都以相同的顺序排列。
5. 然后我遍历第二个数组中的文件名，并将每个文件读入一个文本字段，然后我对其进行解析以查找脚本运行的结果。
6. 然后将该结果写入第三个数组中，该数组与我读取的文件名的逻辑位置相同。
7. 最后，我将文件名重新写入工作表，覆盖其中的内容，并在相邻列中，将运行结果从第三个数组中的相关单元格位置写入。

然后我将得到一个文件，其中包含一个可见点中的所有数据（我希望如此）。

在稍后阶段，我将添加一个脚本，该脚本将通过电子邮件向相关团队发送他们需要处理的 ws 列表（运行结果不为零的那些）以及他们需要做什么。但这不适合此时此地。

因为如果我运行代码并且它可以工作（我希望）它会执行更新，而我还不想这样做，我真正想要的是额外的眼睛来检查我的代码，看看如果我为上面定义的每个动作写的内容是正确的并且会起作用，并且如果有办法写出我所做的事情，那就更好了。

总的来说，我经历了每个阶段，一切都“看起来”不错。

有人愿意帮忙吗？

应@CDP1802的要求添加：

可在文本文件中找到的两种不同结果的示例。一个包含零的结果，这意味着脚本有效。另一个包含 1603 的代码，这是来自 M$ msiexec 的通用“船长有问题但我不知道它是什么”的响应。

文本行之间的空格是实际文本文件中显示的内容。

示例 1（0 响应）

PsExec v2.33 - Execute processes remotely
Copyright (C) 2001-2021 Mark Russinovich
Sysinternals - www.sysinternals.com


C:\Windows\system32>msiexec /i "\\server\Minstall\Installation.msi" /qn ACCEPTEULA=YES REPORTSERVER=server.domainname USESSL=TRUE REPORTSERVERPORT=443 IGNORESSLERRORS=TRUE InstallCertificates=yes /l*v C:\Windows\TEMP\install_log4258289.txt 
Connecting to K190LPRTLV4.iaadom...


Starting PSEXESVC service on K190LPRTLV4.iaadom...


Copying authentication key to K190LPRTLV4.iaadom...


Connecting with PsExec service on K190LPRTLV4.iaadom...


Copying d:\Install425.bat to K190LPRTLV4.iaadom...


Starting d:\Install425.bat on K190LPRTLV4.iaadom...



Install425.bat exited on K190LPRTLV4.iaadom with error code 0.

示例 2（1603 响应）

PsExec v2.33 - Execute processes remotely
Copyright (C) 2001-2021 Mark Russinovich
Sysinternals - www.sysinternals.com


C:\Windows\system32>msiexec /i "\\server\Minstall\Installation.msi" /qn ACCEPTEULA=YES REPORTSERVER=server.domainname USESSL=TRUE REPORTSERVERPORT=443 IGNORESSLERRORS=TRUE InstallCertificates=yes /l*v C:\Windows\TEMP\install_log4258289.txt 
Connecting to K190LPRTLV3.iaadom...


Starting PSEXESVC service on K190LPRTLV3.iaadom...


Copying authentication key to K190LPRTLV3.iaadom...


Connecting with PsExec service on K190LPRTLV3.iaadom...


Copying d:\Install425.bat to K190LPRTLV3.iaadom...


Starting d:\Install425.bat on K190LPRTLV3.iaadom...



Install425.bat exited on K190LPRTLV3.iaadom with error code 1603.

更新代码如下：

    Option Explicit
    
    Sub Check_Files()
    
        Const Col_Names = "A"
        Const Col_Result = "B"
        Const Row_Text = 4 'first line of text and result
    
        Dim wb As Workbook
        Dim wsMain As Worksheet
        Dim WSNames() As String 'Will hold all the ws names as an array read from column A
        Dim WSResult() 'Will hold result for specific ws
        Dim DirectoryListArray() As string
        ReDim DirectoryListArray(3000) 'Set the directory listing array size to 3000 as a max count
        Dim NumberArray() As Long
        Dim lastrow As Long, FileCount As Long, NumberCount As Long, r As Long, i As Long, j As Long
        Dim awsname as string, strDir As string, strPath As string
        Dim item as variant
        Dim ReadFile As String, text As String, textline As String, RetCode As Integer
            
        Set wb = ActiveWorkbook
        With wb
            Set wsMain = .Sheets("Main")
        End With
    
        'Copy ws names into array for speed
        With wsMain
             lastrow = .Cells(.Rows.Count, Col_Names).End(xlUp).Row
             If lastrow < Row_Text Then
                 MsgBox "No ws names found in column " & Col_Names, vbCritical
                 Exit Sub
             End If
             WSNames = .Cells(1, Col_Names).Resize(lastrow).Value2
             ReDim WSResult(1 To lastrow)
        End With
        
        'Write how many names were read into array
        Cells(1,3) = "Number of names read into array is " & lastrow
    
        'loop through all ws names and run the batch file for each one
        For r = Row_Text To UBound(WSNames)
            awsname = WSNames(r, 1) 'Read in next ws name from array
            Runcmd(awsname)
        Next r
    
        'Write how many batch files were run into worksheet
        Cells(2,3) = "Number of batch files run is " & r
    
        'count how many text files have been created
    
        
        strDir = "D:\Minstall"
        
        strPath = strDir & "\*.txt"
        
        'Loop through all the files in the directory by using Dir$ function
        MyFile = Dir$(strPath)
        Do While MyFile <> ""
            DirectoryListArray(FileCount) = MyFile
            MyFile = Dir$
            FileCount = FileCount + 1
        Loop
        
        'Reset the size of the array without losing its values by using Redim Preserve 
        Redim Preserve DirectoryListArray(FileCount - 1)
    
        'Write how many text files were found
        Cells(3,3) = "Number of txt files found is " & FileCount
    
        ''Debug.Print writes the results to the Immediate window (press Ctrl + G to view it)
        'For FileCount = 0 To UBound(DirectoryListArray)
            'Debug.Print DirectoryListArray(FileCount)
        'Next FileCount
    
        'Sort the arrays so that we have the same order in both arrays
        'Since both arrays should in effect have the same amount of elements
            
        'sorting names array from A to Z
        For i = LBound(WSNames) To UBound(WSNames)
            For j = i + 1 To UBound(WSNames)
                If UCase(WSNames(i,1)) > UCase(WSNames(j,1)) Then
                    Temp = WSNames(j,1)
                    WSNames(j,1) = WSNames(i,1)
                    WSNames(i,1) = Temp
                End If
            Next j
        Next i
    
        'sorting file array from A to Z
        For i = LBound(DirectoryListArray) To UBound(DirectoryListArray)
            For j = i + 1 To UBound(DirectoryListArray)
                If UCase(DirectoryListArray(i,1)) > UCase(DirectoryListArray(j,1)) Then
                    Temp = DirectoryListArray(j,1)
                    DirectoryListArray(j,1) = DirectoryListArray(i,1)
                    DirectoryListArray(i,1) = Temp
                End If
            Next j
        Next i
    
        NumberCount = 0
    
        'Loop through files in directory based on what's in array
        For i = LBound(DirectoryListArray) To UBound(DirectoryListArray)
        
            ReadFile = "D:\Minstall" & "\" & DirectoryListArray(NumberCount)
            ReadFile = Application.GetOpenFilename()
            Open myFile For Input As #1
            Do Until EOF(1)
                Line Input #1, textline
                text = text & textline
            Loop
        
            Close #1
            
            RetCode = InStr(text, "with error code ")
            NumFound = Mid(text, posLat + 16, 1)
            If NumFound > 0 Then
                NumFound = Mid(text, posLat + 16, 4)
                'Write the number found into the number array
                NumberArray(NumberCount) = NumFound
                NumberCount = NumberCount + 1
            Else
                'Write the number found into the number array
                NumberArray(NumberCount) = NumFound
                NumberCount = NumberCount + 1
            End If
        
        Next i
        
        'Write the ws name into the worksheet and write the number found to the cell to the right of the ws name in the worksheet
    
        For i = LBound(WSNames) To UBound(WSNames)
    
            Cells(j, Col_Names) = WSNames(i,1)
            Cells(j, Col_Result) = NumberCount(i,1)
            
            j = j + 1
    
        Next i
    
    End Sub
    
    Sub Runcmd(awsname)
    
        Dim PathToBatch as string
        
        'Set the path and batch file with the ws name as a parameter for the batch to run
        PathToBatch = "D:\min425.cmd" & " " & awsname
        
        Call Shell(PathToBatch, vbNormalFocus)
        
    End Sub

Answer 1

主要更改是使用FileSystemObject 读取文本文件，使用Regular Expression 提取错误代码，以及使用WScript.Shell 对象运行批处理文件，因此宏等待脚本完成。我已将 RunCmd 行注释掉，并将其替换为 RunTest，它会创建一个文本文件，以便您对其进行测试。

Option Explicit

Sub Check_Files()
    
    Const DIR_OUT = "D:\Minstall"
    Const COL_NAMES = "A"
    Const COL_RESULTS = "B"
    Const COL_TS = "C" ' timestamp
    Const COL_ERR = "D" ' Shell errors
    Const ROW_START = 4 'first line of text and result
    
    Dim wb As Workbook, ws As Worksheet
    Dim rng As Range, arNames, awsname As String
    Dim result As String, txtfile As String
    Dim i As Long, LastRow As Long, n As Long, r As Long, colour As Long
    Dim t0 As Single: t0 = Timer
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Main")
    With ws
    
        ' read names into array
        LastRow = .Cells(.Rows.Count, COL_NAMES).End(xlUp).Row
        n = LastRow - ROW_START + 1
        
        If n < 1 Then
            MsgBox "No records found on " & ws.Name, vbCritical
            Exit Sub
        Else
            Set rng = .Cells(ROW_START, COL_NAMES).Resize(n)
            arNames = rng.Value2
            'Write how many names were read into array
            .Cells(1, 3) = "Number of names read into array is " & n
        End If
             
        ' clear results
        With rng.Offset(, 1).Resize(, 3)
            .Clear
            .Interior.Pattern = xlNone
        End With
                        
        '  run commands with WsSCript
        Dim WShell As Object
        Set WShell = CreateObject("WScript.Shell")
        For i = 1 To UBound(arNames)
            awsname = arNames(i, 1)
            r = ROW_START + i - 1
            
           ' RUN COMMANDS
           .Cells(r, COL_ERR) = RunTest(awsname, DIR_OUT)
           '.Cells(r, COL_ERR) = RunCmd(WShell, awsname, DIR_OUT)
                     
           .Cells(r, COL_TS) = Format(Now, "yyyy-mm-dd HH:MM:SS") ' timestamp
        Next
        Set WShell = Nothing
        
        'Write how many batch files were run into worksheet
        .Cells(2, 3) = "Number of batch files run is " & UBound(arNames)
                            
        ' read text files with FSO, parse with regex
        Dim FSO As Object, ts As Object, regex As Object, txt As String
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set regex = CreateObject("VBScript.RegExp")
        With regex
            .Global = False
            .MultiLine = True
            .IgnoreCase = True
            .Pattern = "with error code (\d+)"
        End With

        n = 0
        ' process text file
        For i = 1 To UBound(arNames)
            r = ROW_START + i - 1
            awsname = arNames(i, 1)
            txtfile = DIR_OUT & awsname & ".txt"
            result = ""
            
            ' does file exist for this machine
            If FSO.fileExists(txtfile) Then
            
                ' read file
                n = n + 1
                Set ts = FSO.openTextfile(txtfile)
                txt = ts.readall
                ts.Close
                               
                ' extract error number from text
                If regex.test(txt) Then
                    result = regex.Execute(txt)(0).submatches(0)
                End If
                   
                ' error codes
                If result = "0" Then
                    colour = RGB(0, 255, 0) ' green
                Else
                    colour = RGB(255, 255, 0) ' yellow
                End If
                
            Else
                result = "No Text File"
                colour = RGB(255, 0, 0) ' red
            End If
            
            ' result
            With .Cells(r, COL_RESULTS)
                .Value2 = result
                .Interior.Color = colour
            End With
        Next
        
        .Cells(3, 3) = "Number of txt files found is " & n
        .Columns.AutoFit
    End With
    MsgBox "Text files found for " & n, vbInformation, Format(Timer - t0, "0.0 secs")
    
End Sub

Function RunTest(awsname As String, folder As String) As String
    Dim FSO, ts, errno: Set FSO = CreateObject("Scripting.FileSystemObject")
    If Rnd() < 0.3 Then errno = 0 Else errno = Int(10000 * Rnd())
    Set ts = FSO.createTextFile(folder & awsname & ".txt")
    ts.write "This is with error code " & errno & "." & vbCrLf & vbCrLf
    ts.Close
    RunTest = "Test"
End Function

Function RunCmd(WShell, awsname As String, folder As String) As String
 
    MsgBox "RunCmd DISABLED", vbCritical: End
    'Const SCRIPT = "D:\min425.cmd"
    'Dim cmd: cmd = SCRIPT & " " & awsname
    'RunCmd = WShell.Run(cmd, vbNormal, True) ' waittocomplete
    
End Function