VBA scrapping of USPTO website

[ScooterNorm]

Excel Version (Office 2016)

Excel Environment (desktop, Windows)

Knowledge Level - Intermediate level

I'm trying to scrape off the USPTO website. When I do a manual search the URL is: https://tsdr.uspto.gov and I enter a serial number (i.e. 79349658), press the status button and the search is executed and the results are returned.

The resulting URL of the search page is:

https://tsdr.uspto.gov/#caseNumber=...TION&caseType=DEFAULT&searchType=statusSearch

When I try to execute this with VBA, it returns the tsdr.uspto.gov web page, not the result of the search. Any idea what I'm doing wrong?

Here's the code,

Sub Test()
Dim ht As HTMLDocument
Dim IE As InternetExplorer

Set IE = New InternetExplorer
IE.Visible = True
IE.navigate ("Trademark Status & Document Retrieval" & _
"&caseSearchType=US_APPLICATION" & _
"&caseType=DEFAULT" & _
"&searchType=statusSearch")

Do Until IE.readyState = READYSTATE_COMPLETE And IE.Busy = False
DoEvents
Loop

Set ht = IE.document

'IE.Quit

End Sub

 

[ScooterNorm]

Here's an alternative method...

Sub test()

    'Set a reference (VBE > Tools > References) to the following libraries:
    '   1) Microsoft XML, v6.0
    '   2) Microsoft HTML Object Library

    Dim xmlReq As MSXML2.ServerXMLHTTP60
    Dim htmlDoc As MSHTML.HTMLDocument
    Dim strURL As String
    Dim strResp As String
   
    Set xmlReq = New MSXML2.ServerXMLHTTP60
   
    Set htmlDoc = New MSHTML.HTMLDocument
   
    strURL = "https://tsdr.uspto.gov/statusview/sn79349658"
   
    With xmlReq
        .Open "GET", strURL, False
        .send
        If .Status <> 200 Then
            MsgBox "Error " & .Status & ":  " & .statusText
            Exit Sub
        End If
        strResp = .responseText
    End With
   
    htmlDoc.body.innerHTML = strResp
   
    'etc
    '
    '
   
    Set xmlReq = Nothing
    Set htmlDoc = Nothing

End Sub

Hope this helps!

Hey Dominic,
I'm trying to convert to ServerXMLHTTP60 and am getting stuck here.

....
`htmlDoc.body.innerHTML = strResp
'Set elems1 = htmlDoc.body.getElementsByClassName("double table")
....

Also, I've seen some comments where ServerXMLHTTP60 doesn't work but ServerXMLHTTP does.
Your thoughts?

Thanks,
-Norm

 

[Domenic]

When you say that you're getting stuck, what do you mean exactly? Are you getting an error? If so, which error, and on which line?

Did you set a reference (Visual Basic Editor >> Tools >> References) to both Microsoft XML, v6.0 and Microsoft HTML Object Library ?

 

[ScooterNorm]

When you say that you're getting stuck, what do you mean exactly? Are you getting an error? If so, which error, and on which line?

Did you set a reference (Visual Basic Editor >> Tools >> References) to both Microsoft XML, v6.0 and Microsoft HTML Object Library ?

Sorry about not being clearer.
The error occurs on this line
'Set elems1 = htmlDoc.body.getElementsByClassName("double table")

And the error is shown in the image.
Thanks,

 

[Domenic]

getElementsByClassName is a method of the HTML document object, so it should be . . .

Set elems1 = htmlDoc.getElementsByClassName("double table")

 

[ScooterNorm]

getElementsByClassName is a method of the HTML document object, so it should be . . .

Set elems1 = htmlDoc.getElementsByClassName("double table")

Domienic,
OK, got past that problem.
Now I get the same error after this

.....
    Set elems1 = htmlDoc.getElementsByClassName("double table")
    If elems1.Length = 0 Then GoTo ExitFunction
    For i = 0 To elems1.Length - 1
        s = Left(elems1(i).innerText, Len(cEmailAddr))
        s = UCase(s)
        Debug.Print "i<" & i & "> s [" & s & _
                            "] [" & cEmailAddr & "]"
        If s = cEmailAddr Then
            Debug.Print "Found it at i<" & i & "> "
            Set elems2 = elems1(i).getElementsByClassName("value")
....

At the line `Set elems2 = elems1(i).getElementsByClassName("value")
I'm getting the same error. "Object does not support this property or method"
Thanks,

 

[Domenic]

At the line `Set elems2 = elems1(i).getElementsByClassName("value")

Seems fine, how have you declared elems2 ?

 

[ScooterNorm]

Seems fine, how have you declared elems2 ?

Same as elems1

` Dim elems1, elems2, elems3 As Object

And feel free to suggest any best practices, if you have them.
Thanks,

 

[ScooterNorm]

Hey Dominic,
Turns out everything was in the element elems1 and the Set elems2 = elems1(i).getElementsByClassName("value") was not necessary. That's what was causing the error.
I'll mark this solved by you and thanks again.

Shortly, I'll be embarking on another project and might need some help there.

If you're ever in Paris, let me know, I owe you a beer or two.
-Norm

 

[Domenic]

That's great, I'm glad you've got it sorted it.

Cheers!