Website Extract to Excel using VBA

[rult1985]

Hi everyone - my first post so please be kind

I have a list of URLs in column A I need to get the data from these URL's into Column B it is JSON data but I can work with that once it's in Excel
There are 10000 URLs

I have used this and it works well for 1 URL that's in the code, but I need it to reference Column A (it's just a number change 1.json, 2.json etc)



Private Sub HTML_VBA_Excel()
Dim oXMLHTTP As Object
Dim sPageHTML As String
Dim sURL As String

'Change the URL before executing the code
sURL = "https://ipfs.io/ipfs/QmTn4e8DAhViozojav8AAwXiU2CwV7qM62dMYxdj8DcH8r/1.json"

'Extract data from website to Excel using VBA
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oXMLHTTP.Open "GET", sURL, False
oXMLHTTP.send
sPageHTML = oXMLHTTP.responseText

'Get webpage data into Excel
ThisWorkbook.Sheets(1).Cells(1, 1) = sPageHTML

MsgBox "XMLHTML Fetch Completed"

End Sub


Any help would be much appreciated.

 

[Dan_W]

Hmmm - how far did you get? You should update the code to start from wherever it left off so you're not needlessly downloading the same thing over and over again. So, if you got as far as #20, then change the line to: For i = 20 to 10000

When I tested the code, it download the first 50 easily enough.

 

[rult1985]

The first time on 1 it was about 60, I tried 0.5 and got to 90 tried 2 and its stopped at 36.

I would have absolutely no idea how to change the code to continue where it stopped - am I cheeky to ask if you know how?

 

[Dan_W]

LOL - of course I know how - I just wrote it, didn't I?
I made a few changes to code because there were a few things that irked me. It should now be a little faster, and it will produce an status update in the Immediate Window in the VBA Editor every 20 files it downloads to give you a sense of where it is up to. Give me one second and I'll post the updated code.

 

[Dan_W]

Try this - you will need to change the StartNumber in the line of code. As below, just change the line: StartNumber = 20
Hitting the server with a lot of requests in quick succession probably won't win you a lot of friends, but hitting the server with a lot of requests quickly to download the same thing over and over again will really put you in someone bad books

Private Sub HTML_VBA_Excel()

Dim oXMLHTTP As Object
Dim sPageHTML As String
Dim sURL As String

On Error GoTo ErrHandler

Dim i As Long, StartNumber As Long
Const WAIT As Boolean = True
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")

StartNumber = 20

For i = StartNumber To 10000
    'Change the URL before executing the code
    sURL = "https://ipfs.io/ipfs/QmTn4e8DAhViozojav8AAwXiU2CwV7qM62dMYxdj8DcH8r/" & i & ".json"
    'Extract data from website to Excel using VBA
    oXMLHTTP.Open "GET", sURL, False
    oXMLHTTP.send
    sPageHTML = oXMLHTTP.responseText

    'Get webpage data into Excel
    ThisWorkbook.Sheets(1).Cells(i, 1) = sPageHTML

    If i Mod 20 = 0 Then
        MSG = "Completed file " & i
        Debug.Print MSG
        Application.StatusBar = MSG
    End If
    If WAIT = True Then
        PAUSE 1
    End If
Next

Set oXMLHTTP = Nothing
Application.StatusBar = ""
MsgBox "XMLHTML Fetch Completed"

Exit Sub

ErrHandler:
Debug.Print "Error " & Err.Number & " - " & Err.Description
PAUSE 2
Debug.Print "Press F5 to try again"
Stop
Resume Next

End Sub

 

[Dan_W]

Also, you will need to keep the PAUSE subroutine - the above amended code just updates the first routine. What it also does it give you a status update to you the StatusBar on the bottom of the Excel window. And, if it does encounter an error, it gets routed through to an error handler where it prints out the error details into the Immediate Window, and then pauses for 2 seconds. It stops the code, from which point you can press F5 to try again - it will try and resume from where it left off. If you want to stop the code, you will need to press stop.
Hope that all makes sense.

 

[rult1985]

Oh I am sure I will annoy someone - the F5 resume is working too - thank you again.

 

[Dan_W]

No problem - glad it's working - if you find yourself having to keep pressing F5, you should revise up the PAUSE time until it stops bugging you.