Extracting data from Wall Street Journal using VBA

[patricklee]

Hi all,

I have a question to ask about VBA. I am trying to create a excel file that takes information off the website (AAPL Annual Income Statement - Apple Inc. Annual Financials) based on a stock name I enter in the first excel sheet. So when I type in the stock name, and click on the Search button (runs the VBA program) i created, it will search on the website for that stock and retrieve the 5 years financial data. How can I incorporate web query function in it? PLEASE HELP ME! THANKS!



Sub AddNewWorksheet()
Dim Val As String
Val = Sheets(1).Range("B4").Value
Sheets.Add
ActiveSheet.Name = Val
ActiveSheet.Move after:=Sheets(4)


End Sub

 

[VBA Geek]

You need to add a Reference to Microsoft XML, and another to Microsoft HTML Object Library

Sub Get_Fin_Data()
Const strUrl As String = "http://www.marketwatch.com/investing/stock/aapl/financials"
Dim oXML As MSXML2.XMLHTTP
Dim oHTML As MSHTML.HTMLDocument
Dim lngRow As Long
Dim lngCol As Long
Dim lngTable As Long
Dim lngX As Long
Set oXML = New MSXML2.XMLHTTP
Set oHTML = New MSHTML.HTMLDocument
With oXML
    .Open "GET", strUrl, False
    .Send
    oHTML.Body.innerHTML = .responseText
End With
lngX = 0
With oHTML.getElementsByTagName("table")
    For lngTable = 0 To .Length - 1
        For lngRow = 0 To .Item(lngTable).Rows.Length - 1
            For lngCol = 0 To .Item(lngTable).Rows(lngRow).Cells.Length - 1
                Range("A1").Offset(lngRow + lngX, lngCol).Value = .Item(lngTable).Rows(lngRow).Cells(lngCol).innerText
            Next lngCol
        Next lngRow
        lngX = lngRow + lngX
    Next lngTable
End With
Range("A:Z").EntireColumn.AutoFit
Set oXML = Nothing
Set oHTML = Nothing
End Sub

 

[patricklee]

Thanks! But how do I add a reference to Microsoft XML and to HTML object library?
I am a super beginner!

You need to add a Reference to Microsoft XML, and another to Microsoft HTML Object Library

Sub Get_Fin_Data()
Const strUrl As String = "http://www.marketwatch.com/investing/stock/aapl/financials"
Dim oXML As MSXML2.XMLHTTP
Dim oHTML As MSHTML.HTMLDocument
Dim lngRow As Long
Dim lngCol As Long
Dim lngTable As Long
Dim lngX As Long
Set oXML = New MSXML2.XMLHTTP
Set oHTML = New MSHTML.HTMLDocument
With oXML
    .Open "GET", strUrl, False
    .Send
    oHTML.Body.innerHTML = .responseText
End With
lngX = 0
With oHTML.getElementsByTagName("table")
    For lngTable = 0 To .Length - 1
        For lngRow = 0 To .Item(lngTable).Rows.Length - 1
            For lngCol = 0 To .Item(lngTable).Rows(lngRow).Cells.Length - 1
                Range("A1").Offset(lngRow + lngX, lngCol).Value = .Item(lngTable).Rows(lngRow).Cells(lngCol).innerText
            Next lngCol
        Next lngRow
        lngX = lngRow + lngX
    Next lngTable
End With
Range("A:Z").EntireColumn.AutoFit
Set oXML = Nothing
Set oHTML = Nothing
End Sub

 

[VBA Geek]

in the VB Editor, accessed by typing Alt + F11 while you are in Exce, you have tools




Click on References

then scroll down to find both of them, tick them and press ok

 

[patricklee]

So if i were to add the renaming command inside the code you provided me with, where could I insert them?

Also, when I want to search for say Google stock, I have to replace the "aapl" with "goog". Is there any way I can change the aapl into a cell value?

Thank you so much!

 

[VBA Geek]

what is the remaining command? the references just need to be added, after you click ok there is nothing else to do about them.


for the URL you just need to build the website string, so "

Const strCompany = "goog"

[TABLE="width: 48"]
<COLGROUP><COL style="WIDTH: 48pt" width=64><TBODY>[TR]
[TD="width: 64, bgcolor: transparent"][SIZE=3][COLOR=#000000][SIZE=3][COLOR=#000000]"[URL]http://www.marketwatch.com/investing/stock/[/URL]" & strCompany & "/financials"[/COLOR][/SIZE][TABLE="width: 48"]
<COLGROUP><COL style="WIDTH: 48pt" width=64><TBODY>[TR]
[TD="width: 64, bgcolor: transparent"][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/TD]
[/TR]
</TBODY>[/TABLE]
[/COLOR][/SIZE][/TD]
[/TR]
</TBODY>[/TABLE]

[TABLE="width: 48"]
<COLGROUP><COL style="WIDTH: 48pt" width=64><TBODY>[TR]
[TD="width: 64, bgcolor: transparent"][/TD]
[/TR]
</TBODY>[/TABLE]

 

[patricklee]

Sub Get_Fin_Data()


Const strCompany = "goog" [COLOR=#ff0000](How do I change the goog into a cell value? Say to ask VBA to retrieve the stock code from a certain cell in worksheet 1)[/COLOR]


Const strUrl As String = "http://www.marketwatch.com/investing/stock/" & strCompany & "/financials"
Dim oXML As MSXML2.XMLHTTP
Dim oHTML As MSHTML.HTMLDocument
Dim lngRow As Long
Dim lngCol As Long
Dim lngTable As Long
Dim lngX As Long
Set oXML = New MSXML2.XMLHTTP
Set oHTML = New MSHTML.HTMLDocument [COLOR=#ff0000](where can I add a command to add the data onto a newly created worksheet and rename it as the cell value say A1 from sheet 1)[/COLOR]
With oXML
.Open "GET", strUrl, False
.Send
oHTML.Body.innerHTML = .responseText
End With
lngX = 0
With oHTML.getElementsByTagName("table")
For lngTable = 0 To .Length - 1
For lngRow = 0 To .Item(lngTable).Rows.Length - 1
For lngCol = 0 To .Item(lngTable).Rows(lngRow).Cells.Length - 1
Range("A2").Offset(lngRow + lngX, lngCol).Value = .Item(lngTable).Rows(lngRow).Cells(lngCol).innerText
Next lngCol
Next lngRow
lngX = lngRow + lngX
Next lngTable
End With
Range("A:Z").EntireColumn.AutoFit
Set oXML = Nothing
Set oHTML = Nothing
End Sub

 

[VBA Geek]

Sub Get_Fin_Data()
Dim strUrl As String
Dim strStock As String
strStock = Sheets("Sheet1").Range("A1").Value
strUrl = "[URL]http://www.marketwatch.com/investing/stock/[/URL]" & strStock & "/financials"
Dim oXML As MSXML2.XMLHTTP
Dim oHTML As MSHTML.HTMLDocument
Dim lngRow As Long
Dim lngCol As Long
Dim lngTable As Long
Dim lngX As Long
Set oXML = New MSXML2.XMLHTTP
Set oHTML = New MSHTML.HTMLDocument
With oXML
    .Open "GET", strUrl, False
    .Send
    oHTML.Body.innerHTML = .responseText
End With
lngX = 0
Sheets.Add(after:=Sheets(Sheets.Count)).Name = strStock
With oHTML.getElementsByTagName("table")
    For lngTable = 0 To .Length - 1
        For lngRow = 0 To .Item(lngTable).Rows.Length - 1
            For lngCol = 0 To .Item(lngTable).Rows(lngRow).Cells.Length - 1
                Sheets(strStock).Range("A1").Offset(lngRow + lngX, lngCol).Value = .Item(lngTable).Rows(lngRow).Cells(lngCol).innerText
            Next lngCol
        Next lngRow
        lngX = lngRow + lngX
    Next lngTable
End With
Range("A:Z").EntireColumn.AutoFit
Set oXML = Nothing
Set oHTML = Nothing
End Sub