VBA 从 excel 列表到 运行 批处理文件的脚本，读取结果文件，解析结果文件并将结果写入主 excel 文件
VBA script to run batch file from excel list, read result file, parse result file and write result to primary excel file
因此，在我放置代码之前，我将解释我正在尝试做什么，因为我无法自己测试脚本，因为它应该做什么，影响它必须做什么。我知道这有点奇怪，但请耐心等待。
我们目前每两周左右一次 运行 批处理文件来更新我们组织中所有 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
我编写了脚本来执行以下操作：
- 将 A 列中的所有 ws 名称读入数组。
- 遍历数组，并使用Shell函数调用外部cmd文件，然后运行s，并将运行的结果写入位于的TXT文件中在 D 盘上名为“Minstall”的目录中。
- 然后我将在该目录中创建的所有文件的名称读取到一个新数组中。
- 我将两个数组从 A 排序到 Z（使用我在网上找到的脚本），以便在下一阶段以相同的顺序获取所有内容。
- 然后我遍历第二个数组中的文件名，并将每个文件读入一个文本字段，然后解析该文本字段以找到脚本 运行.
的结果
- 然后将结果写入第三个数组中与我读取的文件名相同的逻辑位置。
- 最后，我将文件名重新写入工作表，覆盖其中的内容，并在相邻的列中，我从第三个数组中的相关单元格位置写入 运行 结果。
然后我将得到一个文件，其中包含一个可见点中的所有数据（我希望如此）。
在稍后阶段，我将添加一个脚本，该脚本将通过电子邮件向相关团队发送他们需要处理的 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
主要更改是使用 FileSystemObject to read the text files, a 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
因此，在我放置代码之前，我将解释我正在尝试做什么，因为我无法自己测试脚本，因为它应该做什么，影响它必须做什么。我知道这有点奇怪，但请耐心等待。
我们目前每两周左右一次 运行 批处理文件来更新我们组织中所有 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
我编写了脚本来执行以下操作：
- 将 A 列中的所有 ws 名称读入数组。
- 遍历数组，并使用Shell函数调用外部cmd文件，然后运行s，并将运行的结果写入位于的TXT文件中在 D 盘上名为“Minstall”的目录中。
- 然后我将在该目录中创建的所有文件的名称读取到一个新数组中。
- 我将两个数组从 A 排序到 Z（使用我在网上找到的脚本），以便在下一阶段以相同的顺序获取所有内容。
- 然后我遍历第二个数组中的文件名，并将每个文件读入一个文本字段，然后解析该文本字段以找到脚本 运行. 的结果
- 然后将结果写入第三个数组中与我读取的文件名相同的逻辑位置。
- 最后，我将文件名重新写入工作表，覆盖其中的内容，并在相邻的列中，我从第三个数组中的相关单元格位置写入 运行 结果。
然后我将得到一个文件，其中包含一个可见点中的所有数据（我希望如此）。
在稍后阶段，我将添加一个脚本，该脚本将通过电子邮件向相关团队发送他们需要处理的 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
主要更改是使用 FileSystemObject to read the text files, a 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