Convert code from IE to XMLHTTP

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,054
Office Version
  1. 2016
Platform
  1. Windows
I have traditionally used IE for pulling data of the web, this is my code. I now want to change it to XMLHTTP as it tends to be faster, can some please help me make a few changes as I have made a few attempts but nothing works as i'm not 100% sure what I am doing. The code below works but is slow as it uses IE

VBA Code:
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim wsSheet As Worksheet, links As Variant, IE As Object, link As Variant
Dim rw As Long
Dim dd As Variant

''''SHEET1 as sheet with URL
    Set wb = ThisWorkbook
    Set wsSheet = wb.Sheets("Sheet1")
    
''''Set IE = InternetExplorer
    Set IE = CreateObject("InternetExplorer.Application")
'''' Source sheet, URLS are in Sheet1 column A row2    
    rw = wsSheet.Cells(wsSheet.Rows.Count, "A").End(xlUp).Row
    links = wsSheet.Range("A2:A" & rw)
    
    With IE
       .Visible = False
       
    For Each link In links
        .navigate (link)
    While .Busy Or .readyState <> 4: DoEvents: Wend
On Error Resume Next
    Set doc = IE.document
    
''''IF Statement, change class to suite needs ' Place DATA IN SHEET1 COLUMN B
    If doc.getElementsByClassName("mbg")(0) Is Nothing Then
           Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = "-"
    Else
        dd = doc.getElementsByClassName("mbg")(0).Children(0).href
           Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = dd
    End If
''''navigate links
      Next link     
''''Close IE Browser
    .Quit
End With
    Set IE = Nothing
End Sub

As always thanks in advance
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,054
Office Version
  1. 2016
Platform
  1. Windows
Every now and then when I run my code I get an error message

"runtime error 1004 : Method range of object - 'Global' failed"

If I try to debug the code, the worksheet shuts down. I have tried F8 an running through the code but nothing shows as a error, as the Error only happens every now and then.

Having Googled some answer, I think this MIGHT be the problem bit of the code
VBA Code:
StartRow = wsSheet.Cells(wsSheet.Rows.Count, "B").End(xlUp).Row + 1
    EndRow = wsSheet.Cells(wsSheet.Rows.Count, "A").End(xlUp).Row
    links = WorksheetFunction.Transpose(wsSheet.Range("A" & startrow & ":A" & EndRow))

Found on the net, Link 1, Link 2

Could someone please help me correct this. As I said the problem is hard to locate as it does not happen everytime, it every now and then and I can not debug the code as it shuts down excel.
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
428
Office Version
  1. 365
Platform
  1. Windows
Hi

What does the rest of the code look like? It's slightly odd that the whole spreadsheet shuts down. Can you please try adding/amending the following lines (full revised code below).

Rich (BB code):
    Dim varLinks as Variant
    ....
    StartRow = wsSheet.Cells(wsSheet.Rows.Count, "B").End(xlUp).Row + 1
    EndRow = wsSheet.Cells(wsSheet.Rows.Count, "A").End(xlUp).Row
    varLinks = Range("A" & startrow & ":A" & EndRow)
    links = WorksheetFunction.Transpose(varLinks)

VBA Code:
Dim wb As Workbook
Dim wsSheet As Worksheet, links As Variant, link As Variant
Dim StartRow as Long
Dim EndRow as Long
Dim dd As Variant
Dim doc As HTMLDocument
Dim varLinks as Variant

''''SHEET1 as sheet with URL
    Set wb = ThisWorkbook
    Set wsSheet = wb.Sheets("test")
   
    StartRow = wsSheet.Cells(wsSheet.Rows.Count, "B").End(xlUp).Row + 1
    EndRow = wsSheet.Cells(wsSheet.Rows.Count, "A").End(xlUp).Row
    varLinks = Range("A" & startrow & ":A" & EndRow)
    links = WorksheetFunction.Transpose(varLinks)

For Each link In links
    Set doc = NewHTMLDocument(CStr(link))

''''IF Statement, change class to suite needs ' Place DATA IN Sheet7 COLUMN B
    If doc.getElementsByClassName("mbg")(0) Is Nothing Then
           Sheet7.Cells(Sheet7.Cells(Sheet7.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = "-"
    Else
        dd = doc.getElementsByClassName("mbg")(0).Children(0).href
           Sheet7.Cells(Sheet7.Cells(Sheet7.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = dd
    End If

''''navigate links
     Next link
End Sub


Public Function NewHTMLDocument(strURL As String) As Object
    Dim objHTTP As Object, objHTML As Object, strTemp As String
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.Open "GET", strURL, False
    objHTTP.send
    If objHTTP.Status = 200 Then
        strTemp = objHTTP.responseText
    Set objHTML = CreateObject("htmlfile")
    objHTML.body.innerHTML = strTemp
    Set NewHTMLDocument = objHTML
Else
   'There has been an error
End If
End Function
 

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
428
Office Version
  1. 365
Platform
  1. Windows
Also, what are the values of startrow and endrow when it crashes? The error will likely arise when the end row turns out to be zero or something like that (ie: there are no entries in Row A).
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,054
Office Version
  1. 2016
Platform
  1. Windows
I keep getting a run time error message 13

1597311175817.png


Error code line
1597311062936.png



Also
I can get the "runtime error 1004 : Method range of object - 'WorkSheet' failed" at any point. If I start from the top (begining), then start row is always row2. I can have urls from row 2 to X and as soon as I click start I can get the RunTime Error 1004 message.

There are always entries in column A so if the start row was row X in column A, there are always entries below it. I have never run the code with 0 entries to process. As advised the error is every now and then and its a WorkSheet Fail not a Global Fail as I had originaly posted. When I try to debug excel shuts the sheet down and then restart.

1597311678143.png


It MAY JUST BE me, as I have had to stopped the code, using the Esc KEY a few times and the error from that action may NOT have cleared correct before I restarted the code. If you think your code is correct then the problem my be my actions and I may need help to create a Stop button, to end the code correct.


I have added an On time auto Save

VBA Code:
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:03:00"), "SaveThis"
End Sub

Module

VBA Code:
Sub SaveThis()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True

Application.OnTime Now + TimeValue("00:03:00"), "SaveThis"
End Sub
 

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
428
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

HI - do you need to run the SaveThis sub every minute? If you want it to save all results, why not just run it the once at the end of the scraping sub?
 

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
428
Office Version
  1. 365
Platform
  1. Windows
Have you tried stepping through the code (F8 function key) - it would be useful to know what the StartRow and EndRow values are, and just to double check the varlinks variant to make sure it is, at least, capturing the URLs.
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,054
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

The Save code was only introduced as the code would SOMETIMES crash, this way if it crashed then atleast I would have some saved work.

Also SOMETIMES I would get an error message "runtime error 1004 : Method range of object - 'WorkSheet' failed" and excel would shut down if I clicked on END or DEBUG.

Even without I get the "runtime error 1004 : Method range of object - 'WorkSheet' failed" message.
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,054
Office Version
  1. 2016
Platform
  1. Windows
I have done F8, the problem is the error only happens SOMETIMES so there is no guarantee that the error will show when I am doing F8, the error is a bit hit and miss.

Example

I have 100 urls, I run the code and then stop at the 30 url. When I restart the code, the "runtime error 1004 : Method range of object - 'WorkSheet' failed" error MAY or MANY NOT happen. It is a bit hit and miss. Sometimes the code will continue fine, othertimes the code give the runtime error message and crashes excel, closing it down.

ps I have been using the ESC key to stop the code, possibley this is the issue as it may NOT clear the error when the code is restarted. I possiblly need a stop button.
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,054
Office Version
  1. 2016
Platform
  1. Windows
Also I thing I need something like this added to bypass urls that are dead or need the security certificate OKAY to continue
Mr Excel Thread
If the website has an invalid security certificate or the url is DEAD then the code does not navigate to the next url, it waits for a user input of "YES".
1598962681786.png

If the certificate is invalid or url is DEAD then it should move to the next url, so if site has not loaded in X amount of time move to the next url.
 

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
428
Office Version
  1. 365
Platform
  1. Windows
Can you give an example of a dead URL pls.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,860
Messages
5,638,732
Members
417,049
Latest member
baka416

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top