Invoke automation tool from excel

[softbaba]

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub RunTests_Click()

'startQTP, if it's not yet running
Set qtpApp = CreateObject("QuickTest.Application") ' Create the Application object
qtpApp.Launch ' Start QuickTest, if it's not already running
qtpApp.Visible = True ' Make the QuickTest application visible

TestFolder = Cells(2, 4)
If (Len(TestFolder) > 0) And (Right(TestFolder, 1) <> "\") Then
TestFolder = TestFolder & "\"
End If

ResultsSheetName = Year(Now) & "-" & Month(Now) & "-" & Day(Now) & "-" & Hour(Now) & Minute(Now) & Second(Now)
ThisSheet = ActiveSheet.Name
Worksheets.Add(After:=ActiveSheet).Name = ResultsSheetName
Cells(1, 1) = "Test Name"
Cells(1, 2) = "Iteration"
Cells(1, 3) = "Step"
Cells(1, 4) = "Status"
Cells(1, 5) = "Description"
With Range("A1:E1")
.Font.Bold = True
.Interior.ColorIndex = 48 'grey
.Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
.Columns.AutoFit
End With

Worksheets(ThisSheet).Activate

FirstRow = 7
LastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row 'Last row used
For i = FirstRow To LastRow
If Cells(i, 1) <> "" Then 'found a new test to potentially be run
Set NextTest = Columns(1).Find("*", Cells(i, 1), , xlWhole, xlByRows, xlNext) 'finds the next non-blank cell in column 1
If (NextTest Is Nothing) Or (NextTest.Row < i) Then 'this is the last test on the page
LastDataRow = LastRow
Else
LastDataRow = NextTest.Row - 1
End If
For j = i + 1 To LastDataRow
If UCase(Cells(j, 2)) = "Y" Then
qtpApp.Open TestFolder & Cells(i, 1), False
Set pDefColl = qtpApp.Test.ParameterDefinitions
Set rtParams = pDefColl.GetParameters() ' Retrieve the Parameters collection defined for the test.
Set rtParam1 = rtParams.Item("XLSheet") ' Retrieve the XLSheet parameter.
Set rtParam2 = rtParams.Item("ResultsSheet") ' Retrieve the ResultsSheet parameter.
rtParam1.Value = Application.ActiveWorkbook.FullName
rtParam2.Value = ResultsSheetName
qtpApp.Test.Run , True, rtParams ' Run the test with changed parameters.
While qtpApp.Test.IsRunning
Sleep 5000
Wend
Exit For
End If
Next
End If
Next

Worksheets(ResultsSheetName).Columns("A:E").AutoFit
MsgBox "Test Run complete."

End Sub

 

[SkipVought]

...and the question is?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}