以下代码是在QC里运行QTP来执行脚本过程，当执行过程中发现用例失败后就会自动截图，然后把用例返回到最初始的状态，模拟了场景恢复的机制
1 Class QCImageErrorCapture 2 Dim qtpApp 3 Sub Class_Initialize() 4 Set qtpApp = CreateObject("QuickTest.Application") 5 If qtpApp.CurrentDocumentType = "Test" Then 6 qtpApp.Test.Settings.Run.DisableSmartIdentification = False'False 7 qtpApp.Test.Settings.Run.OnError = "Stop" '"NextStep" "stop" 8 else 9 qtpApp.BusinessComponent.Settings.Run.OnError = "Stop" 10 End If 11 End Sub 12 Sub Class_Terminate() 13 'Check if the current test has failed. If failed then only capture screenshot 14 If Reporter.RunStatus = micFail Then 'and qtpApp.CurrentDocumentType = "test" Then 15 CaptureAndAttachDesktop 16 End If 17 End Sub 18 19 Private Sub CaptureAndAttachDesktop() 20 'QC is not connected 21 If QCUtil.IsConnected = False then Exit Sub 22 23 'The test is not running from Test Lab 24 If QcUtil.CurrentRun is Nothing Then Exit Sub 25 26 On error resume next 27 'Hide QTP to make sure we don't get QTP in snapshot 28 ' Set qtpApp = CreateObject("QuickTest.Application") 29 ' qtpApp.Test.Settings.Run.DisableSmartIdentification = True 30 ' msgbox "display" 31 qtpApp.visible = False 32 33 'GIve time for QTP to get hidden 34 Wait 2 35 36 'Capture the screenshot to the report folder 37 Desktop.CaptureBitmap Reporter.ReportPath & "/Report/ErrorImage.png", True 38 qtpApp.visible = True 39 ' Browser("title:=视博云业务全流程管理平台").Close 40 41 ' SystemUtil.CloseProcessByName "iexplore.exe" 42 ' isFail = True 43 44 Reporter.ReportEvent micFail, "失败截图", "失败截图", Reporter.ReportPath & "/Report/ErrorImage.png" 45 46 47 If qtpApp.CurrentDocumentType = "Test" Then 48 Browser("title:=视博云业务全流程管理平台").Page("title:=视博云业务全流程管理平台").Frame("html id:=FM_Logo").Image("file name:=icon_exit.png").Click 49 wait 1 50 Browser("title:=视博云业务全流程管理平台").Dialog("text:=来自网页的消息", "nativeclass:=#32770").WinButton("text:=确定").Click 51 end if 52 53 'Add the capture to QC 54 ' Set oAttachments = QCutil.CurrentRun.Attachments 55 ' Set oAttachment = oAttachments.AddItem(null) 56 ' oAttachment.FileName = Reporter.ReportPath & "/Report/ErrorImage.png" 57 ' oAttachment.Type = 1 'File 58 59 'Check if the current test is a QTP Test or Business Component 60 ' Select Case LCase(qtpApp.CurrentDocumentType) 61 ' Case "test" 62 ' print "test" 63 ' oAttachment.Description = "Name: " & qtpApp.Test.Name & vbNewLine & "Error: " & qtpApp.Test.LastRunResults.LastError 64 ' Case "business component" 65 ' oAttachment.Description = "Name: " & qtpApp.BusinessComponent.Name & vbNewLine & "Error: " & qtpApp.BusinessComponent.LastRunResults.LastError 66 ' 67 ' 'We can also add the Business COmponent to a User Defined Field 68 ' 'QCUtil.CurrentTestSetTest.Field("TC_USER_01") = qtpApp.BusinessComponent.Name 69 ' 'QCUtil.CurrentTestSetTest.Post 70 ' End Select 71 ' 72 ' 'Add the attachment 73 ' oAttachment.Post 74 ' print "post" 75 End Sub 76 End Class 77 78 'Create the object in one of the attached libraries. When the Test or Business component ends 79 'the screenshot will be captured 80 Set oErrorCapture = new QCImageErrorCapture