How do I import data from URL's in an excel sheet

[Viktor]

Hi everyone,

Beginner in programming here.
I want to import data from roughly 2'000 URLs as part of my thesis. Since they are all different, I used Ctrl+U in my browser and copied all URLs into column A in one of my sheets ("Notification links").

Now I would like to import data into new and separate worksheets from each URL. i.e. Data from URL contained in cell A1 to be imported in the newly created Sheet1, A2 to Sheet2 etc.

Here is the code I did for inserting 2 entries. The points where I get errors, I have market with *'s

[VBA]
For i = 1 To 2
Sheets.Add After:=Sheets(Sheets.Count)
Set Link = Sheets("Notification links").Cells(i, 1)
' Importing the data from the variable "Link"
' *
Sheets("Sheet(i)").Select
' **
With ActiveSheet.QueryTables.Add(Connection:= _
"Link" _
, Destination:=Range("$A$1"))
.Name = "market-news-detail.html?announcementId=11724575"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next i

End Sub
[/VBA]

*I keep getting a Run-time error 9: Subscript out of range
**Even if I remove the variable from the sheet name to resolve the first error, here I get another error Run-Time error 1004: Application defined or object defined error.

[p45cal]

Check that the name of the sheet EXACTLY MATCHES "Notification links" with no extra spaces. It's easiest to copy the name from the tab on the sheet into the vbe.

re: Sheets("Sheet(i)").Select
that i inside the quotes isn't interpreted at all. It's looking for a sheet called Sheet(i). I suspect you may be wanting
Sheets(i).select
or
Sheets("Sheet" & i).select
more probably this last.

[Viktor]

Sheets("Sheet" & i).select

That solved the issue with the sheet naming, thank you!

Any idea how to fix the data import from the URLs? I suspect that the issue lies in using the variable "Link" as URL location, but I wouldn't know how to fix that.

[p45cal]

Take the quote marks away from either side of Link in

With ActiveSheet.QueryTables.Add(Connection:= _ 
        "Link" _ 
        , Destination:=Range("$A$1"))

leaving:

With ActiveSheet.QueryTables.Add(Connection:= _ 
        Link _ 
        , Destination:=Range("$A$1"))

as long as there's a valid link in each cell it looks as though it might work - haven't tested though.

[Viktor]

Thanks for getting back to this p45cal. After removing the quotation marks I receive another error: Error 5: Invalid procedure call or argument in the same lines of code.

[Kenneth Hobs]

Wow, 2,000 sheets? Why don't you just let it create the sheets?

Try posting an example workbook with 2 or 3 "links" so that we can test.

[p45cal]

A shot in the dark: could it be that you links don't include URL; ?
If so, add the bit in red below:

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Link _
, Destination:=Range("$A$1"))

[Viktor]

Wow, 2,000 sheets? Why don't you just let it create the sheets?

Yes, 2000. I don't know any other way to automate this. If you have a more efficient approach, I'd be happy to hear it!

Try posting an example workbook with 2 or 3 "links" so that we can test.

Here is an example file with 3 URLs and my code on it:
VBAExpress Example.xlsm

Thanks!

[p45cal]

I guessed correctly, code below with a few other changes to make it run more smoothly(!):

Sub ImportFromURLs()
'
' ImportFromURLs Macro
' This Macro should import data from each of the URLs in column A of sheet "Notification Links" into a newly created Sheet.

Dim Link
For i = 1 To 3
  Sheets.Add After:=Sheets(Sheets.Count)
  Link = Sheets("Notification links").Cells(i, 1).Value
'Selection.Copy
'Sheets("Sheet" & i).Select
  With ActiveSheet.QueryTables.Add(Connection:= _
                                  "URL;" & Link _
                                   , Destination:=Range("$A$1"))
     '.Name = "market-news-detail.html?announcementId=11724575"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
  End With
Next i
End Sub

[Kenneth Hobs]

Remove SpeedOn and SpeedOff routines if you do not add the module with them. SpeedOn will help with speed, to a small degree. With 2,000 sheets, it will take alot of time and could well fail at some point. Anyway, this does work for the 3 hyperlinks that you posted.

Sub ken()
  Dim hl As Hyperlink
  ' 'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
  SpeedOn
  On Error Resume Next
  For Each hl In Sheets(1).Hyperlinks
    Sheets.Add After:=Sheets(Sheets.Count)
    With ActiveSheet.QueryTables.Add("URL;" & hl.Address, ActiveSheet.Range("A1"))
        .Refresh False
    End With
  Next hl
  SpeedOff
End Sub

[Viktor]

Works great now, thank you!

[snb]

You can refer to the newly added sheet using:

Sub M_snb()
    On Error Resume Next
    
    For Each hl In Sheets(1).Hyperlinks
        With Sheets.Add(, Sheets(Sheets.Count))
            .QueryTables.Add("URL;" & hl.Address, .Cells(1)).Refresh = False
        End With
    Next
End Sub