UFT FrameWork_Driver File

MsgBox "Start"
'Current Directory Path
Set WS=CreateObject("Wscript.Shell")
Path= WS.CurrentDirectory
'Create UFT Object
Set app=CreateObject("QuickTest.Application")
'Launch UFT By selecting addins
If app.Launched=False Then
    app.SetActiveAddins Array("Web")
    app.Launch
    app.Visible=True
End if
'Global Settings
Set App = CreateObject("QuickTest.Application")
App.Options.Run.MovieCaptureForTestResults = "Never"
App.Options.Run.RunMode = "Fast"
App.Options.Run.ViewResults = False
'Open Test Script
Set ObjXl=CreateObject("Excel.Application")
Set ObjWB=ObjXl.WorkBooks.Open (Path&"\Controller\RegSuit.xlsx")
Set ObjWS=ObjWB.WorkSheets(1)
Rc=ObjWS.UsedRange.Rows.Count
For i=2 to Rc

    If Trim(LCase(ObjWS.Cells(i,3).Value))="yes" Then
        Test_Name=ObjWS.Cells(i,2).Value
        'Open test script
        app.Open path&"\Scripts\"&Test_Name
        'Associate SOR
        Actions_Cnt= app.Test.Actions.Count
        For j=1 to Actions_Cnt
            app.Test.Actions(j).ObjectRepositories.RemoveAll
            app.Test.Actions(j).ObjectRepositories.Add Path&"\SOR\ActiTime_SOR.tsr"       
        Next
       
        'Associate Function Library
        App.Test.Settings.Resources.Libraries.RemoveAll
        App.Test.Settings.Resources.Libraries.Add(Path&"\LibFun\ActiFunLib.qfl")
       
        'Execute UFT Script
        app.test.Run
        'Get Result
        Res= app.test.LastRunResults.Status
        ObjWS.Cells(i,4).Value=Res
        If Res="Passed" Then
            ObjWS.Cells(i,4).Font.ColorIndex=4
        Else
            ObjWS.Cells(i,4).Font.ColorIndex=3
        End if
    Else
        ObjWS.Cells(i,4).Value="Not Executed"
    End if
Next
'Save and close Excel file
Ts=Replace(Replace(Now,"/","_"),":","_")
ObjWB.SaveAs Path&"\Results\"&Ts&".xlsx"
ObjXl.Quit

'Close UFT
app.Quit


REM Call SendMail("manager@outlook.com","Execution Res","Matter","F:\Acti_FrameWork\Results\"&Ts&".xlsx")
REM Call SendMail("manager@outlook.com","Execution Res","Matter","")

Function SendMail(SendTo, Subject, Body, Attachment)
    Set ol=CreateObject("Outlook.Application")
    Set Mail=ol.CreateItem(0)
    Mail.to=SendTo
    Mail.Subject=Subject
    Mail.Body=Body
    If (Attachment <> "") Then
        Mail.Attachments.Add(Attachment)
    End If
    Mail.Send
    ol.Quit
    Set Mail = Nothing
    Set ol = Nothing
End Function

MsgBox "End"