• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Can't let a macro populate results when it is used in 64 bit windows whereas it works flawlessly in 32 bit

shahin

Active Member
I've created a macro using xmlhttp requests to get the status of a Parcel ID from a website. This is how to populate the status manually.

1. When you track the site link , you will see an inputbox right next to parcel id. Use this id 03008088 and press the search button. You should see a new page exactly like I've shown in the image two.
2. Now click on the view bill button which should lead you to the result page which you can see in image three.
3. I'm after this text `Parcel is in tax sale`.

This is the site link: https://taxpayments.carolinemd.org/MSS/citizens/RealEstate/Default.aspx?mode=new

It is necessary to encode the strings "mystring" and "mynewstring" which are supposed to be sent with post requests. When it comes to encode string, I usually go for "WorksheetFunction.EncodeURL()" but in this very case I could notice that the script encounters this error (Run-time error 1004. Unable to get the encodeurl property of the worksheetfunction class.) when I use "WorksheetFunction.EncodeURL()" within "mynewstring" so, I used "EncodeURL()" function instead of "WorksheetFunction.EncodeURL()" to encode the strings. I'm using win 32 and the following macro automates the aforesaid steps flawlessly.

However, I could get a complaint that it doesn't work in 64 bit. Could you help me figure out what happens when the following macro is made to run in 64 bit windows as it works flawlessly in 32 bit?

Code:
Public Function EncodeURL(url As Variant) As String
  Dim buffer As String, i As Long, c As Long, n As Long
  buffer = String$(Len(url) * 12, "%")

  For i = 1 To Len(url)
    c = AscW(Mid$(url, i, 1)) And 65535

    Select Case c
      Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95  ' Unescaped 0-9A-Za-z-._ '
        n = n + 1
        Mid$(buffer, n) = ChrW(c)
      Case Is <= 127            ' Escaped UTF-8 1 bytes U+0000 to U+007F '
        n = n + 3
        Mid$(buffer, n - 1) = Right$(Hex$(256 + c), 2)
      Case Is <= 2047           ' Escaped UTF-8 2 bytes U+0080 to U+07FF '
        n = n + 6
        Mid$(buffer, n - 4) = Hex$(192 + (c \ 64))
        Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
      Case 55296 To 57343       ' Escaped UTF-8 4 bytes U+010000 to U+10FFFF '
        i = i + 1
        c = 65536 + (c Mod 1024) * 1024 + (AscW(Mid$(url, i, 1)) And 1023)
        n = n + 12
        Mid$(buffer, n - 10) = Hex$(240 + (c \ 262144))
        Mid$(buffer, n - 7) = Hex$(128 + ((c \ 4096) Mod 64))
        Mid$(buffer, n - 4) = Hex$(128 + ((c \ 64) Mod 64))
        Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
      Case Else                 ' Escaped UTF-8 3 bytes U+0800 to U+FFFF '
        n = n + 9
        Mid$(buffer, n - 7) = Hex$(224 + (c \ 4096))
        Mid$(buffer, n - 4) = Hex$(128 + ((c \ 64) Mod 64))
        Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
    End Select
  Next

  EncodeURL = Left$(buffer, n)
End Function

Sub GetInformation()
    Const url = "https://taxpayments.carolinemd.org/MSS/citizens/RealEstate/Default.aspx?mode=new"
    Const innerUrl = "https://taxpayments.carolinemd.org/MSS/citizens/RealEstate/ParcelBrowse.aspx"
    Dim mystring As Variant, i&, n&, elem$, Htmldoc As New HTMLDocument, searchKey$, kstr As Variant
    Dim Row&, MyDict As Object, aMyDict As Object, DictKey As Variant, oelem As Object, mynewstring As Variant

    Dim Http As Object: Set Http = CreateObject("MSXML2.XMLHTTP")

    Set MyDict = CreateObject("Scripting.Dictionary")
    Set aMyDict = CreateObject("Scripting.Dictionary")
  
    With Http
        .Open "GET", url, True
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
        .send
        While .readyState < 4: DoEvents: Wend
        Htmldoc.body.innerHTML = .responseText
    End With

    With Htmldoc.querySelectorAll("input[name]")
        For n = 0 To .Length - 1
            On Error Resume Next
            MyDict.Add .Item(n).getAttribute("name"), .Item(n).getAttribute("value")
            On Error GoTo 0
        Next n
    End With

    MyDict("ctl00$ctl00$PrimaryPlaceHolder$ContentPlaceHolderMain$Control$ParcelIdSearchFieldLayout$ctl01$ParcelIDTextBox") = "03008088"

    kstr = "ctl00$ctl00$PrimaryPlaceHolder$ContentPlaceHolderMain$Control$FormLayoutItem7$ctl01$resetButton"
    If MyDict.exists(kstr) Then
        MyDict.Remove kstr
    End If

    For Each DictKey In MyDict
        mystring = IIf(Len(DictKey) = 0, EncodeURL(DictKey) & "=" & EncodeURL(MyDict(DictKey)), _
                        mystring & "&" & EncodeURL(DictKey) & "=" & EncodeURL(MyDict(DictKey)))
    Next DictKey
  
    With Http
        .Open "POST", url, True
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
        .send mystring
        While .readyState < 4: DoEvents: Wend
        Htmldoc.body.innerHTML = .responseText
    End With

    elem = Htmldoc.querySelector("a.functionlink[id][href*='__doPostBack']").getAttribute("href")
    elem = Split(Split(elem, "__doPostBack('")(1), "',")(0)

    With Htmldoc.querySelectorAll("input[name]")
        For n = 0 To .Length - 1
            On Error Resume Next
            aMyDict.Add .Item(n).getAttribute("name"), .Item(n).getAttribute("value")
            On Error GoTo 0
        Next n
    End With

    aMyDict("__EVENTTARGET") = elem

    For Each DictKey In aMyDict
        mynewstring = IIf(Len(DictKey) = 0, EncodeURL(DictKey) & "=" & EncodeURL(aMyDict(DictKey)), _
                        mynewstring & "&" & EncodeURL(DictKey) & "=" & EncodeURL(aMyDict(DictKey)))
    Next DictKey

    With Http
        .Open "POST", innerUrl, True
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
        .send mynewstring
        While .readyState < 4: DoEvents: Wend
        Htmldoc.body.innerHTML = .responseText
    End With

    Set oelem = Htmldoc.querySelector("p.taxSaleAlertStyle")
    MsgBox oelem.innerText
End Sub

Once again If you are using 32 bit windows, you see `Parcel is in tax sale` when you execute the macro. However, you will encounter some error when you are on 64 bit windows and that is what I'm trying to seek a solution for.
 

Attachments

  • 1.jpg
    1.jpg
    16.2 KB · Views: 7
  • 2.jpg
    2.jpg
    56.4 KB · Views: 7
  • 3.jpg
    3.jpg
    39 KB · Views: 5
Hello my friend
I am using Windows 64 Bit and I tried your code and I got the message "Parcel is in tax sale " at the end so the code is working fine on Windows 10 64 Bit with no problems.
Can you specify the error that appears within the person who tested the code?
 
So far I can remember, he was getting some error which was pointing at this line
`elem = Htmldoc.querySelector("a.functionlink[id][href*='__doPostBack']").getAttribute("href")`. Thanks YasserKhalil for the feedback. It is always a pleasure to hear anything from you.
 
So you see it is possible to get rid of hardcoded `viewstate` and stuff which contain very long string that we discussed about years back. I've taken the logic from python by the way @YasserKhalil.
 
Try this line like that (maybe solve the problem)
Code:
elem = Htmldoc.querySelectorAll("a.functionlink[href*='__doPostBack']")(1).getAttribute("href")
 
That is not really the problem of the selector. That line threw that error when the response doesn't contain the stuff we are looking for. Your defined selector should work as well.
 
One last thing - could you confirm whether it works when you replace this function `EncodeUriComponent` with this function `EncodeURL`. The rest should be as it is.

Code:
Function EncodeUriComponent(strText)
    Static objHtmlfile As Object
    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
    End If
    EncodeUriComponent = objHtmlfile.parentWindow.encode(strText)
End Function
 
Maybe you have to set an object for the element then check if the object is nothing or not ..
Something like that
Code:
On Error Resume Next
dim elem as object
set elem = Htmldoc.querySelectorAll("a.functionlink[href*='__doPostBack']")(1)
On Error Goto 0

If Not elem is Nothing Then
....Do stuff
End If
 
Yes the UDF EncodeUriComponent is working well too. I have replaced the existing UDF with the new one and replaced the lines in your code and it works without any problems at all. What is the office version did he have? I have Office 32 Bit version installed in Windows 10 64 Bit.
 
Hi @YasserKhalil, hope you are doing well. Could you tell me the office version you have in your machine? I'm using office 2013 and the macro I've written is doing fine here. However, I need to know how the same macro behaves when it is tested on 2019. Thanks.
 
As nothing in your code is a concern according to the Excel version but on the OS version and with the 'bad' idea to use MSXML2.XMLHTTP …​
Surprised too to see an EncodeURL VBA procedure as it's a built in function since Excel 2013 version …​
 
Back
Top