none
Please HELP! Error: -2147012894 (80072ee2) the operation timed out on WinHttpRequest.5.1 RRS feed

  • Question

  • Hello

    I REALLY NEED SOME GUIDANCE ON THIS ERROR.

    Does anyone know why this could be happening.  I am getting the error:  -2147012894 (80072ee2) the operation timed out.  I have this code in an Excel macro.  I am sending the URL an XML string and am expecting a response but I am getting the time out error on the SEND.  I have tried using the SetTimeouts method, but I still get the error.    

    Could it be my machine settings?  Does WinHTTPRequest work with Excel VBA?  I am just lost at this point.  I have researched, and have seen examples of Excel VBA using WinHTTPRequest.  I do not know why I am getting the error.

    Your help is very much appreciated.  I really need some direction on how to resolve this issue. 

    smsemail

    Private Sub CmdGetData_Click()
        colLabel = 1
        colStreetAddress = 23
        colCity = 24
        colState = 25
        colZipCode = 26
        colZipFour = 27
        
        lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
        
        For rw = 4 To lastRow
            
            If Worksheets("Sheet1").Cells(rw, colStreetAddress).Value = "" Then GoTo nextLabel:
        
            If Worksheets("Sheet1").Cells(rw, colCity).Value = "" And _
               Worksheets("Sheet1").Cells(rw, colState).Value = "" And _
               Worksheets("Sheet1").Cells(rw, colZipCode).Value = "" Then GoTo nextLabel:
           
            If (Worksheets("Sheet1").Cells(rw, colCity).Value = "" And _
                Worksheets("Sheet1").Cells(rw, colState).Value = "") Or _
                Worksheets("Sheet1").Cells(rw, colZipCode).Value = "" Then GoTo nextLabel:
                
            strStreetAddress = Worksheets("Sheet1").Cells(rw, colStreetAddress).Value
            strCity = Worksheets("Sheet1").Cells(rw, colCity).Value
            strState = Worksheets("Sheet1").Cells(rw, colState).Value
            strZipCode = Worksheets("Sheet1").Cells(rw, colZipCode).Value
            
            'Initialize variables
            strXML = ""
            Label = Worksheets("Sheet1").Cells(rw, colLabel).Value
                
            'Write XML header information
            Call WriteXMLHeader
            
            'Write address information to XML file
            strXML = strXML & "<p3:AddressCriteria>"
            strXML = strXML & "<p3:CanadianProvince></p3:CanadianProvince>"
            strXML = strXML & "<p4:LocationCityName>" & strCity & "</p4:LocationCityName>"
            strXML = strXML & "<p4:LocationCountyName></p4:LocationCountyName>"
            strXML = strXML & "<p4:LocationPostalCode></p4:LocationPostalCode>"
            strXML = strXML & "<p4:LocationStateUSPostalServiceCode>" & strState & "</p4:LocationStateUSPostalServiceCode>"
            strXML = strXML & "<p4:StreetFullText>" & strStreetAddress & "</p4:StreetFullText>"
            strXML = strXML & "</p3:AddressCriteria>"
            
            'Write XML footer information
            Call WriteXMLFooter
           
            'URI
            strURI = "https://a325.wgs.thomson.com/api/v1/person/searchResults"
            strUserID = "xxxxxxx"
            strUserPassword = "yyyyyyyy"
            Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
            httpRequest.SetTimeouts 80000, 80000, 90000, 90000
            With httpRequest
               .Open "POST", strURI, False
               .SetRequestHeader "Content-type", "application/xml"
               .SetRequestHeader "Content-Length", Len(strXML)
               .SetRequestHeader "Authorization", "Basic " & EncodeBase64(strUserID & ":" & strUserPassword)
               ''.SetClientCertificate ("LOCAL_MACHINE\Personal\Certificates\WGS CA\kchin tmp dev cert")
               .SetClientCertificate ("LOCAL_MACHINE\Personal\kchin tmp dev cert")
               .Send (strXML)
            End With
            
            If httpRequest.Status = 200 Then
               MsgBox httpRequest.GetAllResponseHeaders
            Else
               MsgBox httpRequest.Status & ": " & httpRequest.StatusText
            End If
            
            MsgBox httpRequest.ResponseText
              
    nextLabel:
        Next rw
           
        MsgBox "PROCESSING HAS COMPLETED", vbOKOnly, "E-Interdiction Clear Update"
            
    End Sub
    Public Sub WriteXMLHeader()
        strXML = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>"
        strXML = strXML & "<psr1:PersonSearchRequest " & "xmlns:psr1=" & Chr(34) & "http://wgs.thomsonreuters.com/clear/api/search/1.0 " & Chr(34) & " xmlns:xsi=" & Chr(34) & "http://www.w3.org/2001/XMLSchema-instance" & Chr(34) & ">"
        strXML = strXML & "<PermissiblePurpose>"
        strXML = strXML & "<GLB>L</GLB>"
        strXML = strXML & "<DPPA>1</DPPA>"
        strXML = strXML & "<VOTER>2</VOTER>"
        strXML = strXML & "</PermissiblePurpose>"
        strXML = strXML & "<Reference>S2S Test</Reference>"
        strXML = strXML & "<Criteria>"
        strXML = strXML & "<p1:PersonCriteria"
        strXML = strXML & "xmlns:p1=" & Chr(34) & "http://wgs.thomsonreuters.com/clear/api/search/person-search/niem/1.0" & Chr(34) & ""
        strXML = strXML & "xmlns:p2=" & Chr(34) & "http://niem.gov/niem/structures/2.0" & Chr(34) & ""
        strXML = strXML & "xmlns:p3=" & Chr(34) & "http://wgs.thomsonreuters.com/clear/api/search/person-search-extension/niem/1.0" & Chr(34) & ""
        strXML = strXML & "xmlns:p4=" & Chr(34) & "http://niem.gov/niem/niem-core/2.0" & Chr(34) & ">"
    End Sub
    Public Sub WriteXMLFooter()
        strXML = strXML & "</p1:PersonCriteria>"
        strXML = strXML & "</Criteria>"
        strXML = strXML & "<Datasources>"
        strXML = strXML & "<PublicRecordCriminalAndInfractions>false</PublicRecordCriminalAndInfractions>"
        strXML = strXML & "<PublicRecordPeople>true</PublicRecordPeople>"
        strXML = strXML & "<NPIRecord>false</NPIRecord>"
        strXML = strXML & "<WorkAffiliations>false</WorkAffiliations>"
        strXML = strXML & "<RealTimeIncarcerationAndArrests>false</RealTimeIncarcerationAndArrests>"
        strXML = strXML & "</Datasources>"
        strXML = strXML & "</psr1:PersonSearchRequest>"
      
    End Sub
    Public Function EncodeBase64(text As String) As String
         Dim arrData() As Byte
         arrData = StrConv(text, vbFromUnicode)
         Dim objXML As MSXML2.DOMDocument
         Dim objNode As MSXML2.IXMLDOMElement
         Set objXML = New MSXML2.DOMDocument
         Set objNode = objXML.createElement("b64")
         objNode.DataType = "bin.base64"
         objNode.nodeTypedValue = arrData
         EncodeBase64 = objNode.text
         
         Debug.Print EncodeBase64
         Set objNode = Nothing
         Set objXML = Nothing
         
    End Function

    Wednesday, March 4, 2015 4:08 PM