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驱动器上名为"的目录中的TXT文件；Minstall">
3. 然后，我将在该目录中创建的所有文件的名称读取到一个新数组中
4. 我将两个数组从A到Z排序(使用我在网上找到的脚本(，以便在下一阶段按相同的顺序获得所有内容
5. 然后，我循环遍历第二个数组中的文件名，并将每个文件读取到一个文本字段中，然后解析该文本字段以查找脚本运行的结果
6. 然后，该结果被写入第三个数组，位于我读取的文件名的相同逻辑位置
7. 最后，我将文件名重新写入工作表，覆盖其中的内容，并在相邻列中，从第三个数组中的相关单元格位置写入运行结果

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

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

由于如果我运行代码并且它有效(我希望(，它会执行更新，而我还不想这样做，所以我真正想要的是多看一眼我的代码，看看我为上面定义的每个操作所写的内容是否正确，是否有效，以及是否有办法写我所做的事情，更好。

总的来说，我回顾了每一个阶段；外观；好的

有人愿意在这里帮忙吗？

根据@CDP1802:的请求添加

可以在文本文件中找到两种不同结果的示例。其中一个包含的结果为零，这意味着脚本工作正常。另一个包含1603的代码；有一个问题，队长，但我不知道是什么"；M$msiexec的响应。

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

示例1(0响应(

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

C:Windowssystem32>msiexec /i "\serverMinstallInstallation.msi" /qn ACCEPTEULA=YES REPORTSERVER=server.domainname USESSL=TRUE REPORTSERVERPORT=443 IGNORESSLERRORS=TRUE InstallCertificates=yes /l*v C:WindowsTEMPinstall_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:Windowssystem32>msiexec /i "\serverMinstallInstallation.msi" /qn ACCEPTEULA=YES REPORTSERVER=server.domainname USESSL=TRUE REPORTSERVERPORT=443 IGNORESSLERRORS=TRUE InstallCertificates=yes /l*v C:WindowsTEMPinstall_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读取文本文件，使用正则表达式提取错误代码，使用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