Update code to xmlhttp

[Sharid]

I am struggling to convert this code from IE to xmlhttp E, as It runs very slow with IE. The current code has to open IE every time and then shut it down and then re-open IE to load a new search criteria. I was trying to convert it to xmlhttp, which should work faster, but I am struggling

In Sheet1 A1 I have the search URL
In Sheet1 B1 I have the search Criteria, the search criteria will change after an X numbers of pages have been searched.

In Sheet2 B1 Down I have a list of items that need to be searched. Once it has searched the item it then closes IE, then opens it up again and then move to the next item in Sheet2, The next item is then copied in to Sheet1 B1 .

I have shortened the code so it is more readable. the parts that I removed was to do with stopping and starting the code, and coping the search criteria item from Sheet2 to Sheet1 B1. Which I can add when it is converted to xmlhttp

Private Sub CommandButton4_Click()
Dim Html As htmlDocument
Dim objIE As Object
Dim result As String 'string variable that will hold our result link
Dim pageNumber As Long
Dim nextPageElement As Object
Dim HtmlText As Variant
Dim wsSheet As Worksheet
Dim wb As Workbook
Dim sht As Worksheet

        Set wb = ThisWorkbook
            Set wsSheet = wb.Sheets("Sheet1")
             Set sht = ThisWorkbook.Worksheets("Sheet1")
              
'+++++ Internet Explorer ++++++
On Error Resume Next
        Set objIE = New InternetExplorer 
           objIE.Visible = False 
           objIE.navigate Sheets("Sheet1").Range("A2").Value & Replace(Worksheets("Sheet1").Range("B2").Value, " ", "+") 'navigate IE to this web page
           Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

'######################################## RESTART CODE FROM HERE ####################################
StartForLoop_Restart: 'Restart the code HERE, this is the key part
'######################################## RESTART CODE FROM HERE ####################################
        Application.ScreenUpdating = False
    
       Set Html = objIE.document
          Set elements = Html.getElementsByClassName("s-item__wrapper clearfix") ' parent CLASS
          For Each element In elements
            DoEvents

''' Element 1
        If element.getElementsByClassName("s-item__link")(0) Is Nothing Then ' Get CLASS and Child Nod
            wsSheet.Cells(sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = "-" 'If Nothing then Hyphen in CELL
        Else
            HtmlText = element.getElementsByClassName("s-item__link")(0).href 'Get CLASS and Child Nod
            wsSheet.Cells(sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = HtmlText 'return value in column
        End If

''''' Element 2
        If element.getElementsByClassName("s-item__seller-info-icon")(0) Is Nothing Then ' Get CLASS and Child Nod
            wsSheet.Cells(sht.Cells(sht.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = "-" 'If Nothing then Hyphen in CELL
        Else
            HtmlText = element.getElementsByClassName("s-item__seller-info-icon")(0).href ' Get CLASS and Child Nod
            wsSheet.Cells(sht.Cells(sht.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = HtmlText 'return value in column
        End If
   
Application.ScreenUpdating = True

Next element

Do
' Searches Number of Pages entered in 5 Then Exit Do
    If pageNumber >= 1 Then Exit Do 'Replace(Worksheets("Sheet1").Range("C2").Value, "", "+") Then Exit Do
        On Error Resume Next
        Set nextPageElement = Html.getElementsByClassName("pagination__next")(0) ' CLICK TO NEXT PAGE
    If nextPageElement Is Nothing Then Exit Do
        nextPageElement.Click 'next web page
    Do While objIE.Busy = True Or objIE.readyState <> 4

    Loop
        pageNumber = pageNumber + 0

''##################################### Restart Loop ##################################
'   GoTo StartForLoop_Restart ' use GOTo command and label to reinitiate the CODE AS WOULD NOT LOOP TO NEXT PAGE
''##################################### Restart Loop ##################################
       
'##################################### Restart Loop ##################################
   GoTo StartForLoop_Restart ' use GOTo command and label to reinitiate the CODE AS WOULD NOT LOOP TO NEXT PAGE
'##################################### Restart Loop ##################################
 Loop

            'Clean up
        objIE.Quit ' end and clear browser
            Set objIE = Nothing
            Set Html = Nothing
            Set nextPageElement = Nothing
            Set HtmlText = Nothing
            Set element = Nothing

''' Copy and paste each item from sheet2 column A to sheet1 B2, this is the item to be searched
     Application.ScreenUpdating = False
        With Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
            If .Value <> "" Then
               .Copy Sheets("Sheet1").[B2]
               .Offset(, 1).Value = "Done"
            Else
                Exit Sub
            End If
        End With
    Application.ScreenUpdating = True
 
 Call RestartLoop_Click
End Sub

 

[Marc L]

The current code has to open IE every time and then shut it down and then re-open IE to load a new search criteria.

Seems so weird and badly coded as it is not necessary to close IE for another criteria …​

 

[Sharid]

Marc L

I thought I had replied to your post a few days back, however my reply is not on the forum.

I am extemely limited in vba so was not sure how to write the code. Closing down the browser and reopening IE to load a new search criteria was my work around, currently it take a very long time to process with IE under my code,but that was the best I could do . Therefore I figured I go with xmlhttp as it would be faster, still stuck on this.

If anyone can help it would be greatly appriciated.

Thanks

 

[Marc L]

So as it is this thread is a guessing challenge for some mind readers forum but not for an Excel one !​

​

As a reminder a Web request may need some parameters like cookies & headers as you can see with your webbrowser inspector tool​

and sometimes when it is 'too difficult' to find out there is no choice than piloting IE (I mean under classic VBA) …​

​

Obviously your VBA procedure should be faster just opening IE once and not closing it before any new criteria.​

 

[Dan_W]

Hi @Sharid - it's good to see you back on the Forum.

I would echo @Marc L comment - Internet Explorer isn't the speediest of applications at the best of times, so opening and closing it over and over again is destined for tears.

But looking over the code, I had sudden waves of PTSD wash over me (I'm kidding ) - I can't remember which site this was for, but wasn't the point about IE over XMLHTTP because the page was rendered (in part) with Javascript? If that's the case, then XMLHTTP is simply not a viable option. I can't remember where we got to with the conversation about Selenium, but I think with the upcoming termination of IE, that you need to think about alternatives (I've been thinking about it since we last spoke and have some updates).

There are number of things you can do to speed up the code (move the Application.ScreenUpdating = True outside of the loop and be sure to set it to False before going into the loop, get rid of GoTo StartForLoop_Restart , etc, etc) but I really do feel like we've done all this before, no?

 

[Sharid]

Thanks to both of you for having a look,

I will look at it again and try to make some changes. Dan_w we have had many a conversation and you know I don't know what I am doing. LOL.