VBA script to run batch file from excel list, read result file, parse result file and write result to primary excel file

Question

So, before I place my code, I'll explain what I am trying to do, because I can't test the script myself due to what it is supposed to do, effecting what it must do. I know this is a bit odd, but bear with me please.

Once every two weeks or so, we currently run batch files to update a specific tool on all the WS's in our organization.

Yes, we do have tool propagation software, but as this specific tool is extremely important, we don't trust it's distribution to any automated method which have proven in most cases to fail without us being able to understand the reason.

So, I wrote a few simple command batch files which run the installation command, and write the output to a text file which we then manually go through to find which ws's it was installed on, and which it wasn't.

The ws's on which it was not installed are the ws's we know we know due to the failure, that we have additional issues with and we then put all our effort into finding and fixing those issues.

As you can imagine, it's a time consuming effort, and I have decided I want to automate as much as possible of the manual check, in order to know quickly which ws's failed, and the fail code.

I start out with a list of ws names in excel.

For example,

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

I wrote my script to do the following:

1. Read all the ws names from column A into an array.
2. Loop through the array, and use the Shell function to call an external cmd file which then runs, and writes the result of the run into a TXT file located in a directory on the D drive called "Minstall".
3. I then read the names of all the files created in that directory into a new array.
4. I sort both arrays from A to Z (using a script I found online) to get everything in the same order for the next stage.
5. I then loop through the file names in the 2nd array, and read each file into a text field which I then parse to find the result of the script run.
6. That result is then written into a third array in the same logical position of the file name I read.
7. Finally, I re-write the file names back to the worksheet, overwriting what was there, and in the adjacent column, I write the run result from the relevant cell position in the third array.

I will then end up with a file that contains all the data in one visible point (I hope).

At a later stage, I will add a script that will email the relevant team with a list of the ws's they need to deal with (Those with any run result different from zero), and what they need to do. But that's not for the here and now.

Since if I run the code and it works (I hope) it would perform the update, and I do not yet want to do that, what I am really looking for, is additional eyes to go over my code, to see if what I wrote for each action as defined above is correct and will work, and if there is a way to perhaps write what I did, better.

In general, I went over each stage and everything "looks" good.

Anyone willing to assist here?

Added by request of @CDP1802:

Examples of the two different results that can be found in the text files. One contains a result of zero, meaning that the script worked. The other contains a code of 1603, which is a generic "there's a problem captain but I don't know what it is" response from M$ msiexec.

The spaces between the lines of the text are what appear in the actual text file.

Example 1 (0 response)

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.

Example 2 (1603 response)

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.

The updated code is as follows:

    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

The main changes are using a FileSystemObject to read the text files, a Regular Expression to extract the error code, and a WScript.Shell object to run the batch file so macro waits for the script to complete. I have commented out the RunCmd line and replaced it with a RunTest that creates a text file so you can test it.

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