Using MSXML 6.0 having difficulty signing on w/ uid & pwd

[wornhall]

Hi, all,

The following code is used to access my credit card company to scrape the balance. I already have a working IE edition, but it is slow and awkward. The project is to access my banks, brokerage, credit cards, commodities, even Zillow for the value of my house in order to create a real-time asset management and financial balance sheet with historical values. It is all working, but a bit clumsily. It is all in Excel VBA, and the current goal is to get it working with MSXML 6.0 which is MANY times faster than IE, and much more elegant. With no more than a click, all this happens automagically. This last step will make it a dream project.

So, I ask your help in finding the deficiencies in the following code. It fails validation, delivering the challenge screen.
Note: the actual data extraction will be copied from the IE module. I have added, for your "payment" a Base64Encode function which is great. And a sub-second fetch of my home value from Zillow, which you may use by modifying the URL for the inquiry of your own home, posting the value to an Excel sheet named Zillow.

---

Sub ChaseScrape()
    'password testing of CHASE credit card Warren Hall. 10/5/2017


    Dim XMLpage     As MSXML2.XMLHTTP60
    Dim HTMLdoc     As MSHTML.HTMLDocument
    Dim sHTML        As String
    Dim AnchorLinks As Object, AnchorLink As Object
    Dim TDelements  As Object, TDelement  As Object
    Dim urL              As String, aString    As String
   
    urL = "https://www.chase.com"
    Sheets("Tablez").Select 'add this sheet if not found.
    Range("A1") = Now
        
    aString = "Basic " & Base64Encode((Chr(34) & _
              (Range("TTlogin").Offset(0, 1)) & ":" & _
              (Range("TTpass").Offset(0, 1)) & Chr(34)))
    Cells(2, 1) = aString
    
    On Error GoTo Error_Out
    Set XMLpage = CreateObject("MSXML2.XMLHTTP.6.0")
    Set HTMLdoc = CreateObject("htmlfile")
    
    With XMLpage        'To Test = TT
        .Open "GET", urL, False ', "username", "password"    'real values go there. Testing has been comprehensive in this set of code.
        .setRequestHeader "Content-Type", "text/xml"
        .setRequestHeader "Authorization", "Basic " & aString ' quote sign, Note: rigorously tested
        .setRequestHeader "Accept", "application/xml"           ' I need help in the Header selection and format
        .send
        '.setTimeouts 2000, 2000, 2000, 2000  'ms - resolve, connect, send, receive
        HTMLdoc.body.innerHTML = .responseText
        sHTML = .responseText
        Debug.Print sHTML
    End With
                
    With HTMLdoc '.body
        Set AnchorLinks = .body.getElementsByTagName("a")
        Set TDelements = .body.getElementsByTagName("td")
    
    For Each AnchorLink In AnchorLinks
        Debug.Print AnchorLink.innerText
    Next
    For Each TDelement In TDelements
        Debug.Print TDelement.innerText
    Next
    GoTo Wrapup


Error_Out:
    If XMLpage.Status >= 400 And XMLpage.Status <= 599 Then
        MsgBox "The following error has occured." & vbCrLf & _
               "Number: " & .Status & vbCrLf & _
               "Source: XMLpage" & vbCrLf & _
               "Description: " & .statusText
    Else
        MsgBox "The following error has occured." & vbCrLf & _
               "Number: " & Err.Number & vbCrLf & _
               "Source: XMLpage" & vbCrLf & _
               "Description: " & Err.Description
    End If


Wrapup:
    End With
    On Error Resume Next
    Set XMLpage = Nothing: Set HTMLdoc = Nothing
    Cells(1, 3) = Int(Now)
    'Cells(2,1) = scrapedCCbalance
    Cells(3, 1).Select
    ActiveCell = "=(NOW()-$A$1)*86400"  'now equals seconds (hundredths)
    ActiveCell.Copy
    ActiveCell.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Cells(3, 2) = "Seconds"
    Cells(4, 1) = "Tablez"
End Sub

Function Base64Encode(text As String) As String
    ' This has been tested and validated.
    Dim arrData() As Byte
    arrData = StrConv(text, vbFromUnicode)
    
    Dim objXML As MSXML2.DOMDocument60
    Dim objNode As MSXML2.IXMLDOMElement
    
    Set objXML = New MSXML2.DOMDocument60
    Set objNode = objXML.createElement("b64")
    With objNode
        .DataType = "bin.base64"
        .nodeTypedValue = arrData
        Base64Encode = .text
    End With
    
    Set objNode = Nothing
    Set objXML = Nothing
End Function

By the way, here is the Zillow code:

Sub FetchZI()
' Warren Hall,  Fetch Zillow home price 09/25/2017
        
    Dim XMLpage  As New MSXML2.XMLHTTP60
    Dim HTMLdoc  As New MSHTML.HTMLDocument
    Dim HTMLrows As MSHTML.IHTMLElementCollection
    Dim HTMLrow  As MSHTML.IHTMLElement
    Dim HTMLcell As MSHTML.IHTMLElement
    Dim urL      As String
    Dim index    As Long
    Dim aString  As String
    Dim strT     As Long, enDr As Long
    Sheets("Zillow").Select 'add this sheet if not already there.
    
    Range("A1") = Now
    urL = "https://www.zillow.com/homes/for_sale/31599917_zpid/"
    
    Set XMLpage = CreateObject("MSXML2.XMLHTTP.6.0")
    Set HTMLdoc = CreateObject("htmlFile")   'New MSHTML.HTMLDocument
    With XMLpage
       .Open "GET", urL, False
       .send
        While .readyState <> 4 Or .Status <> 200: DoEvents: Wend
        HTMLdoc.body.innerText = .responseText
        aString = .responseText
    End With
    strT = InStr(1, aString, "$")
    Cells(2, 1) = Mid(aString, strT, 7)
    Cells(1, 3) = Int(Now)
    Cells(3, 1).Select
    ActiveCell = "=(NOW()-$A$1)*86400"  'now equals seconds
    ActiveCell.Copy
    ActiveCell.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Cells(3, 2) = "Seconds"
    Cells(4, 1) = "Zillow"
    Range("A1").Select
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Thank you for your efforts and information.

 

[John_w]

Use Fiddler or your browser's development tools (usually accessed by pressing the F12 key), e.g. the Console and Network tool tabs in Firefox, to examine the requests and responses sent by the browser and website. Your VBA code must emulate these requests.

You might find the code at http://www.mrexcel.com/forum/excel-...n-internet-explorer-web-site.html#post3404965 and in http://www.mrexcel.com/forum/excel-questions/749860-msxmlhttp-post-paramaters.html useful.

 

[wornhall]

Apparently, my description was not clear enough. As my code showed and explanation state that the process uses password and user-id, and the process is interrupted with a challenge screen. That is the problem. Also, I went on and on about the speed and elegance of MSXML coding. The references do not process uid and pwd, and as I stated, the entire process is working with IE. This project is an upgrade to the currently running process and a learning process as well. I have done my due dilligence, and then some, but now need some helpful person to look into the code which does the signing on, to determine the correction or addition needed. I am at wits end at this point.

The module, "FETCHZI" for Zillow is running just fine but does not need a sign-on.

Thanks for your help.