Multiple Table download from the internet to Excel Yahoo Finance Japan

[gilesgerman]

Dear All,

I hope you can help me I am trying to download historical share data for share 8088 from yahoo Japan.

The first page of the table I need is in the following location: - https://info.finance.yahoo.co.jp/hi...1983&sm=11&sd=19&ey=2017&em=12&ed=19&tm=d&p=1

I then want to download all the share data the above is 1～20件/8554件中 as you will see in the top left corner.

The final page is page 428 at the following URL....

https://info.finance.yahoo.co.jp/hi...83&sm=11&sd=19&ey=2017&em=12&ed=19&tm=d&p=428

I am looking to get all these pages from 1-428 into excel on a single sheet so I can complete this analysis.

Giles

 

[pbornemeier]

The following code will do what you asked for, but you will have some cleanup to do. I set it to extract pages 1 to 428. I understand that some sites prevent more than a certain number of downloads in a set short time (e.g., 50 queries per hour). If this is the case you will have to changes this line:

For lPage = 1 To 428 'Manually set page range

to get the pages you want.

That page has 3 tables and your data is in table 2. If you want all of the tables comment out the If tabno = 2 Then line and its corresponding End If line

Option Explicit

Sub ExtractDataFromTables()
    'Modification of
    'http://www.mrexcel.com/forum/excel-questions/259738-general-q-regarding-using-visual-basic-applications-xl-pass-through-ie.html
    
    Dim ie As Object
    Dim myTextField
    Dim doc     'Variant/Object/HTMLDocument
    Dim lPage As Long
    
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        For lPage = 1 To 428   'Manually set page range
            .Visible = True
            '.navigate "http://eoddata.com/stockquote/NASDAQ/AAPL.htm"
            .navigate "https://info.finance.yahoo.co.jp/history/?code=8088.T&sy=1983&sm=11&sd=19&ey=2017&em=12&ed=19&tm=d&p=" & lPage
            Do Until .readyState = 4: DoEvents: Loop
    '        Set myTextField = .Document.all.Item("series_id")
    '        myTextField.Value = "ECU11121I"
    '        ie.Document.Forms(0).submit
    '        Do Until .ReadyState = 4: DoEvents: Loop
    '        Do While .Busy: DoEvents: Loop
            Set doc = ie.document
            GetAllTables doc
        Next
        .Quit
    End With
    
    Set doc = Nothing
    Set ie = Nothing
    
End Sub

Sub GetAllTables(d)

    Dim e   'Variant/Object/HTMLTable
    Dim t   'Variant/Object/HTMLTable
    Dim tabno As Long
    Dim nextrow As Long
    Dim Rng As Range
    Dim R   'Variant/Object/HTMLTableRow
    Dim c   'Variant/Object/HTMLTableCell
    Dim i As Long
    
    For Each e In d.all
        If e.nodeName = "TABLE" Then
            Set t = e
    
            tabno = tabno + 1
            If tabno = 2 Then
                nextrow = Cells(Rows.Count, 2).End(xlUp).Row + 1
                Set Rng = Range("B" & nextrow)
                Rng.Offset(, -1) = "Table " & tabno
                For Each R In t.Rows
                    For Each c In R.Cells
                        Rng.Value = c.innerText
                        Set Rng = Rng.Offset(, 1)
                        i = i + 1
                    Next c
                    nextrow = nextrow + 1
                    Set Rng = Rng.Offset(1, -i)
                    i = 0
                Next R
            End If
        End If
    Next e
    
    Set Rng = Nothing
    Set t = Nothing
    
End Sub