Intraday Data Code

Through my efforts to study the stock market's technicalities I have found my self in need of more and more data.  It's easy for me to go to the Wall Street Journal and download historical data, but that's not the problem.  The problem is finding more frequent data — intraday data.

My quest to find intraday data on Google proved fruitless.  I didn't trust any of those sketchy websites and I I refused to pay any amount of money to data collectors; so, I brought it upon myself to write something that could help me.

At this point in time I have not formal training with writing code, I am purely self taught.  As a consequence my code is quite limited and clumsy, but after a few weeks I was able to pull something together, much in thanks to various forums and trial and error.

My code is written in Visual Basic for Applications (VBA) which can be found in almost all Excel programs.  Like I said, it's quite the round-about but it gets me what I need. This code was built with Windows XP and IE 8.0.6 (I'll try to make this as easy to read as possible):

Before we get started, insert this set of code into module2

'This will search for, find, and USD (explination later)

Sub Macro2()
' Macro2 Macro
    Windows("Html_Dump.txt").Activate
    Cells.Find(What:="USD", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy

End Sub


'This will search for, find, and EDT (explination later)

Sub Macro3()
' Macro3 Macro
    Windows("Html_Dump.txt").Activate
    Cells.Find(What:="edt", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
End Sub

Now for the meat of the code

Sub GetTextOrHtmlFromIe()

'This code works with IE 8.0.6 and you'll have to enable Microsoft HTML Object Library. 

'http://www.mrexcel.com/forum/showthread.php?342939-How-to-save-HTML-source-code-from-VBA/page2
'Much of my code came from this website, atleast the part that goes to IE and grabs the data
'from the WSJ HTML code. What it does is extracts all the HTML code and dump it onto an Excel
'Document

Dim bln As Boolean
Dim ie As Object, objDoc As Object
Dim c As Object

'You'll have to either change the realtime.xlsm to your desired file name (the file
'that holds this code) or save your workbook as realtimequote.xlsm. The "a1:A740" is a
'counter of sorts that lets my code continuously loop throughout the data.  So since this 
'code grabs information every 30 seconds and let my code run for 6 hours, we get 6*60*2 = approx 740
'Also, every time you run this code make sure cells a1:a740 or whatever you end at are cleared. 

For Each c In Workbooks("Realtime.xlsm").Sheets("sheet1").Cells.Range("a1:a740")
    If c = 0 Then

        Const strMsg As String = "To get a text version of your page, click [Yes]," & vbLf & _
        "To get the Html version, click [No]"

'Like I said, I grab my information from the WSJ, so the stock info I'm grabbing is Pfizer,
'if you want another stock change the pfe to your desired ticker symbol

        Const strURI As String = "http://quotes.wsj.com/pfe"
        Set ie = CreateObject("internetexplorer.application")
        ie.Navigate strURI

'Wait for page to loa
        Do
            If ie.ReadyState = 4 Then
                ie.Visible = False
            Exit Do
            Else
                DoEvents
            End If
        Loop

'This is going to pause the application for 20 seconds, it more or less is just making sure my page
'is fully loaded before I grab the HTML code, it always takes up a good portion of my codes wait time,
'i figure this is as good a time as any.

        Application.Wait (Now() + TimeValue("00:00:20"))

'So after I grab my HTML code from Internet Explorer I dump it into an Excel Workbook.  I call this
'workbook HTML_Dump and save it on my C drive.  You can change the filepath if you'd like,
'http://excelexperts.com/VBA-Tips-Import-A-Text-File

        Set objDoc = ie.Document

        Filename = "C:\Html_Dump.txt"
            FileNo = FreeFile
            Open Filename For Binary Access Write As #FileNo
            Put #FileNo, , objDoc.body.innertext
            Close #FileNo
            
        Set objDoc = Nothing
        Set ie = Nothing

        On Error Resume Next

        Set mytextfile = Workbooks.Open("C:\html_dump.txt")

'when the text doucment gets dumped into excel it doesnt seperate all the text.  In otherwords, one line is one cell, 
'so what I have to do is search for a string of unique characters of my desired line, copy, and paste. I do this by 
'calling modules. After moduels are called I use the "text to column" excel function and deliminate to seperate
'all the words, numbers, etc. 

'This module is for a newer version of IE (I'm currently working on it).

        ''Call Module2.Macro1

        ''c.PasteSpecial
        ''Workbooks("Realtime.xlsm").Activate
        ''Application.CutCopyMode = False
        ''Selection.TextToColumns Destination:=c, DataType:=xlDelimited, _
            ''TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
            ''Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
            '':=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            ''Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
            ''), Array(14, 1), Array(15, 1), Array(16, 1)), TrailingMinusNumbers:=True
        ''c.Offset(0, 2).Copy
        ''c.Offset(0,1).PasteSpecial
        ''c.Offset(0, 1).ClearContents
        ''c.Offset(0, 2).ClearContents
        ''c.Offset(0, 3).ClearContents
        ''c.Offset(0, 4).ClearContents
        ''c.Offset(0, 5).ClearContents

        ''On Error Resume Next

'Calling module two, going text to column, and deliminating

        Call Module2.Macro2

        c.Offset(0, 1).PasteSpecial
        Workbooks("Realtime.xlsm").Activate
        Application.CutCopyMode = False
        Selection.TextToColumns Destination:=c.Offset(0, 1), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
            ), Array(14, 1), Array(15, 1), Array(16, 1)), TrailingMinusNumbers:=True
        c.Offset(0, 2).Copy
        c.Offset(0, 1).PasteSpecial
        c.Offset(0, 2).ClearContents
    
'This is for an older version of Windows IE(8.0.6001), may not have to do it on a newer one. In this version
'the price is attached to the USD tag, so it's like 24.75USD -- this deliminates it so we can grab
'only the price
    
        c.Offset(0, 1).Select
        Selection.TextToColumns Destination:=c.Offset(0, 1), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="U", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        c.Offset(0, 13).Copy
        c.Offset(0, 2).PasteSpecial
        Worksheets("sheet1").Cells.Range("D:S").ClearContents

        On Error Resume Next

'Again, same set of rules but calls module3

        Call Module2.Macro3
  
        c.Offset(0, 3).PasteSpecial
        Workbooks("Realtime.xlsm").Activate
        Application.CutCopyMode = False
        Selection.TextToColumns Destination:=c.Offset(0, 3), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
            ), Array(14, 1), Array(15, 1), Array(16, 1)), TrailingMinusNumbers:=True
        c.Offset(0, 10).Copy
        c.PasteSpecial
        Worksheets("sheet1").Cells.Range("d:S").ClearContents
    
        On Error Resume Next

'This closes HTML_dump and deletes it from your computer
    
        mytextfile.Close False
        Kill "c:\HTML_dump.txt"

'This part destroys everything IE (more or less just shuts the program down), so if you're using IE while this code is running
'you will find yourself very irritated. It'll save you RAM by closing all IE background windows. 

        'sledgehammer approach to closing ALL ie windows.
        'http://www.mrexcel.com/forum/showthread.php?t=229394
    
        Dim objWMI As Object, objProcess As Object, objProcesses As Object
        Set objWMI = GetObject("winmgmts://.")
        Set objProcesses = objWMI.ExecQuery( _
        "SELECT * FROM Win32_Process WHERE Name = 'iexplore.exe'")
        For Each objProcess In objProcesses
            Call objProcess.Terminate
        Next
        Set objProcesses = Nothing: Set objWMI = Nothing
    
'This makes the application wait 5 seconds.  So, this 5 seconds plus the 20 seconds above equates a total of 25 seconds of wait time
'plus the (very generously estimated) 5 seconds to let the code run. All in all this takes about 30 seconds to run. 

        Application.Wait (Now() + TimeValue("00:00:15"))

    End If
Next c

End Sub

There are definitely things I could improve on.  For one, I can only do one ticker symbol at a time; which causes a problem, especially when I need to compare data (hard to compare if you have nothing to compare it to).  It would also be nice to add  GUI that gave me fields for parameters and what not.  This is definitely no finished project, but it is the backbone of whats to come.