Function ReportToTestuff(s_test_id) Dim strXML 'XML request string Dim strJSON 'JSON request string Dim strUserName 'user name to connect to the Web API service Dim strUserPassword 'password for the user to connect to the Web API service Dim strWebAPIURL 'Web API service URL Dim s_expected_status, s_steps_failed, s_comment ' set Web API connectivity parameters ' replace email, password and serviceX with your account details strUserName = "Testuff login email" ' <----Change strUserPassword = "Password" ' <----Change strWebAPIURL = "Testuff API url" ' <----Change, sapme https://service2.testuff.com/api/v0/run/ ' set test scenario parameters var_RunStatus = Reporter.RunStatus ' QTP Reporter If var_RunStatus= "0" Then s_status = "passed" End If If var_RunStatus= "1" Then s_status = "failed" End If If var_RunStatus= "2" Then s_status = "passed" End If 's_steps_passed = "3" 's_steps_failed = "2,4" 's_comment = "additional info" 'prepare Web API call data strXML = "<?xml version='1.0' encoding='utf-8'?>" & _ "<object>" & _ "<test_id>" & s_test_id & "</test_id>" & _ "<status>" & s_status & "</status>" & _ "<steps_failed>" & s_steps_failed & "</steps_failed>" & _ "<steps_passed>" & s_steps_passed & "</steps_passed>" & _ "<comment>" & s_comment & "</comment>" & _ "</object>" strJSON = "{" & _ EmbraceInQuotes("test_id") & ":" & EmbraceInQuotes(s_test_id) & "," & _ EmbraceInQuotes("status") & ":" & EmbraceInQuotes(s_status) & "," & _ EmbraceInQuotes("steps_failed") & ":" & EmbraceInQuotes(s_steps_failed) & "," & _ EmbraceInQuotes("steps_passed") & ":" & EmbraceInQuotes(s_steps_passed) & "," & _ EmbraceInQuotes("comment") & ":" & EmbraceInQuotes(s_comment) & _ "}" ' Try XML Request '--------------------------------- strResult = GetDataFromURL(strWebAPIURL, strUserName, strUserPassword, "POST", "application/xml", strXML) ' Try JSON Request '--------------------------------- strResult = GetDataFromURL(strWebAPIURL, strUserName, strUserPassword, "POST", "application/json", strJSON) End Function Function EmbraceInQuotes(str) Dim res res = Chr(34) & str & Chr(34) EmbraceInQuotes = res End Function Function GetDataFromURL(strURL, strLogin, strPassword, strMethod, strContentType, strPostData) Dim lngTimeout Dim intSslErrorIgnoreFlags Dim blnEnableRedirects Dim blnEnableHttpsToHttpRedirects Dim strHostOverride Dim strResponseText Dim objWinHttp Const CREDENTIALS_FOR_SERVER = 0 lngTimeout = 59000 intSslErrorIgnoreFlags = 13056 ' 13056: ignore all err, 0: accept no err blnEnableRedirects = True blnEnableHttpsToHttpRedirects = True strHostOverride = "" Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1") objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout objWinHttp.Open strMethod, strURL If strMethod = "POST" Then objWinHttp.setRequestHeader "Content-type", strContentType End If If strHostOverride <> "" Then objWinHttp.SetRequestHeader "Host", strHostOverride End If objWinHttp.Option(4) = intSslErrorIgnoreFlags objWinHttp.Option(6) = blnEnableRedirects objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects objWinHttp.SetCredentials strLogin, strPassword, CREDENTIALS_FOR_SERVER On Error Resume Next objWinHttp.Send(strPostData) If Err.Number = 0 Then If objWinHttp.Status = "201" Then GetDataFromURL = "Created: " & objWinHttp.GetResponseHeader("Location") Else GetDataFromURL = "Error: " & objWinHttp.ResponseText End If Else GetDataFromURL = "Error " & Err.Number & " " & Err.Source & " " & Err.Description End If On Error GoTo 0 Set objWinHttp = Nothing End Function