Do I Use WinHttp.WinHttpRequest or Microsoft.XMLHTTP?

jjbungles

New Member
Joined
May 8, 2008
Messages
33
Rich (BB code):
Sub Download()
Set occXMLHTTP = CreateObject("Microsoft.XMLHTTP")
Set fso = CreateObject("Scripting.FileSystemObject")
DIY_Dir = "c:\DIYTraders\"
DIYSub_Dir = "c:\DIYTraders\tickers\"
 
If Not fso.FolderExists(DIY_Dir) Then
    MkDir DIY_Dir
End If
 
If Not fso.FolderExists(DIYSub_Dir) Then
    MkDir DIYSub_Dir
End If
Check_Date
PFROW = 1
Do Until Worksheets("Portfolio").Cells(PFROW, 1) = ""
    PFROW = PFROW + 1
Loop
PFROW = PFROW - 1
For x = 1 To PFROW
    fn = Worksheets("Portfolio").Cells(x, 1)
    fname = Worksheets("Portfolio").Cells(x, 1) & ".txt"
    occXLS = DIYSub_Dir & fname
    'occUrl = "http://ichart.finance.yahoo.com/table.csv?s=" & Worksheets("Portfolio").Cells(x, 1) & "&d=" & EM & "&e=" & ED & "&f=" & EY & "&g=d&a=2&b=7&c=2002"
    occUrl = "http://ichart.finance.yahoo.com/table.csv?s=" & Trim(Worksheets("Portfolio").Cells(x, 1)) & _
    "&d=" & SM & "&e=" & SD & "&f=" & SY_2 & "&g=d&a=" & SM & "&b=" & SD & "&c=" & SY
    occLocalFile = DIYSub_Dir & fname
    occLocalFileName = Worksheets("Portfolio").Cells(x, 1) & ".txt"
 
    occXMLHTTP.Open "GET", occUrl, False
    occXMLHTTP.send
    occArray = occXMLHTTP.ResponseBody
    occfile = 1
 
    Open occLocalFile For Binary As #occfile
    Put #occfile, , occArray
    Close #occfile
 
    RemoveLine
Next
Response = MsgBox _
("Download Completed." & vbCrLf & _
"Open C:\DIYTraders\Tickers to view files ?", vbYesNo)
If Response = vbYes Then
    RetVal = Shell("explorer " & DIYSub_Dir, 1)
End If
End Sub
Sub RemoveLine()
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  fname_path = DIYSub_Dir & fname
  DeleteLine = 1
  sTemp = "Date,Open,High,Low,Close,Volume,Adj Close" & vbCrLf
 
  On Error Resume Next
  If oFSO.FileExists(fname_path) Then
     Set oFSTR = oFSO.OpenTextFile(fname_path)
    lCtr = 1
     Do While Not oFSTR.AtEndOfStream
        sLine = oFSTR.ReadLine
        If lCtr <> DeleteLine Then
            sTemp = sTemp & sLine & vbCrLf
        Else
            bLineFound = True
        End If
        lCtr = lCtr + 1
    Loop
 
     oFSTR.Close
     Set oFSTR = oFSO.CreateTextFile(fname_path, True)
     oFSTR.Write sTemp
   End If
oFSTR.Close
Set oFSTR = Nothing
oFSO.MoveFile fname_path, DIYSub_Dir & fn & ".csv"
Remove_Column
oFSO.DeleteFile DIYSub_Dir & fn & ".csv"
Set oFSO = Nothing
End Sub
Sub Remove_Column()
 
    fn1 = fn & ".csv"
    fn2 = fn & ".xls"
    RV = DIYSub_Dir & fn & ".csv"
 
    Workbooks.Open RV
    Set rv1 = Workbooks(fn1).Sheets(fn)
    currRow = 1
    Do
        currRow = currRow + 1
    Loop While rv1.Cells(currRow, 1).Value <> ""
 
    currRow = currRow - 1
 
    rv1.Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
 
    If asc.Value = True Then
        rv1.Range("A1:F" & currRow & "").Select
        Selection.Sort Key1:=rv1.Range("A1:F" & currRow & ""), Order1:=xlDescending, Header:= _
            xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
    End If
 
    Application.DisplayAlerts = False
    Workbooks(fn1).SaveAs Filename:=DIYSub_Dir & fn & ".xls", FileFormat:=xlNormal
    Workbooks(fn2).Close True
End Sub
Sub Check_Date()
    SD = Day(Now)
    SM = Month(Now) - 1
    SY = Year(Now)
    SY_2 = Year(Now)
 
    If y1.Value = True Then
        SY = SY - 1
    ElseIf y2.Value = True Then
        SY = SY - 2
    ElseIf y3.Value = True Then
        SY = SY - 3
    ElseIf y5.Value = True Then
        SY = SY - 5
    ElseIf y10.Value = True Then
        SY = SY - 10
    ElseIf y20.Value = True Then
        SY = SY - 20
    Else
        SY = SY - 1
        y1.Value = True
    End If
End Sub
Private Sub help_1_Click()
    Help.Show
End Sub
Private Sub y1_Click()
    Select Case y1.Value
    Case True
        y2.Value = False
        y3.Value = False
        y5.Value = False
        y10.Value = False
        y20.Value = False
    End Select
End Sub
Private Sub y2_Click()
    Select Case y2.Value
    Case True
        y1.Value = False
        y3.Value = False
        y5.Value = False
        y10.Value = False
        y20.Value = False
    End Select
End Sub
Private Sub y3_Click()
    Select Case y3.Value
    Case True
        y1.Value = False
        y2.Value = False
        y5.Value = False
        y10.Value = False
        y20.Value = False
    End Select
End Sub
Private Sub y5_Click()
    Select Case y5.Value
    Case True
        y1.Value = False
        y2.Value = False
        y3.Value = False
        y10.Value = False
        y20.Value = False
    End Select
End Sub
Private Sub y10_Click()
    Select Case y10.Value
    Case True
        y1.Value = False
        y2.Value = False
        y3.Value = False
        y5.Value = False
        y20.Value = False
    End Select
End Sub
Private Sub y20_Click()
    Select Case y20.Value
    Case True
        y1.Value = False
        y2.Value = False
        y3.Value = False
        y5.Value = False
        y10.Value = False
    End Select
End Sub
Private Sub asc_Click()
    Select Case asc.Value
    Case True
        desc.Value = False
    Case False
        desc.Value = True
    End Select
End Sub
Private Sub desc_Click()
    Select Case desc.Value
    Case True
        asc.Value = False
    Case False
        asc.Value = True
    End Select
End Sub
Private Sub CommandButton1_Click()
    Sheet1.Download
End Sub
Here the one from Tom via this thread: http://www.mrexcel.com/forum/showthread.php?t=327698

Rich (BB code):
Option Explicit
 
'Grabs Yahoo historical stock data
'tstom@fuse.net
'requires Microsoft ActiveX Data Objects 2.6 or later
Private pWinHttpRequest As WinHttp.WinHttpRequest
 
Friend Function GetHistoricalData(Symbol As String, _
    Optional FromDate As Date = #12:00:00 AM#, _
    Optional ToDate As Date = #12:00:00 AM#, _
    Optional Interval As String = "Daily") As ADODB.RecordSet
 
    Dim URL As String, ResponseText As String
    Dim pRecordSet As ADODB.RecordSet
    Dim DateString As String, IntervalString As String
    Dim RTS() As String, RTFI
    Dim x As Long
 
    'http://ichart.finance.yahoo.com/table.csv?s=INTC&a=06&b=9&c=1986&d=2&e=5&f=2008&g=d
 
    If FromDate <> #12:00:00 AM# Or ToDate <> #12:00:00 AM# Then
        If FromDate = 0 And ToDate > 0 Then
            FromDate = #1/1/1900#
        ElseIf FromDate > 0 And ToDate = 0 Then
            ToDate = Date
        End If
        DateString = "&a=" & Format(Month(FromDate) - 1, "00") & "&b=" & Format(FromDate, "DD") & "&c=" & Format(FromDate, "YYYY") & _
                     "&d=" & Format(Month(ToDate) - 1, "00") & "&e=" & Format(ToDate, "DD") & "&f=" & Format(ToDate, "YYYY")
    End If
 
    Select Case Interval
        Case "Daily", "": IntervalString = "&g=d"
        Case "Weekly": IntervalString = "&g=w"
        Case "Monthly": IntervalString = "&g=m"
        Case Else
            Err.Raise 10001, "HistoricalStockDataFromYahoo.GetHistoricalData", "Invalid Interval.  Expected ""Daily"", ""Weekly"", or ""Monthly"""
    End Select
 
    URL = "http://ichart.finance.yahoo.com/table.csv?s=" & Symbol & DateString & IntervalString
 
    pWinHttpRequest.Open "GET", URL, False
    pWinHttpRequest.Send
 
    ResponseText = pWinHttpRequest.ResponseText
    If InStr(ResponseText, "") Then
            Err.Raise 10002, "HistoricalStockDataFromYahoo.GetHistoricalData", "Invalid Search Parameters or other error.  No data was returned."
    End If
 
    Set pRecordSet = New ADODB.RecordSet
 
    pRecordSet.Fields.Append "Date", adDBDate
    pRecordSet.Fields.Append "Open", adCurrency
    pRecordSet.Fields.Append "High", adCurrency
    pRecordSet.Fields.Append "Low", adCurrency
    pRecordSet.Fields.Append "Close", adCurrency
    pRecordSet.Fields.Append "Volume", adInteger
    pRecordSet.Fields.Append "Adj Close", adCurrency
    pRecordSet.Open
 
    RTS = Split(ResponseText, Chr(10))
 
    For x = LBound(RTS) + 1 To UBound(RTS)
        If RTS(x) <> "" Then
            RTFI = Split(RTS(x), ",")
            pRecordSet.AddNew Array("Date", "Open", "High", "Low", "Close", "Volume", "Adj Close"), Array(RTFI(0), RTFI(1), RTFI(2), RTFI(3), RTFI(4), RTFI(5), RTFI(6))
            pRecordSet.Update
        End If
    Next x
 
    pRecordSet.MoveFirst
    Set GetHistoricalData = pRecordSet
End Function
 
Private Sub Class_Initialize()
    On Error Resume Next
    Set pWinHttpRequest = New WinHttpRequest
    If pWinHttpRequest Is Nothing Then
        Err.Raise 10000, "HistoricalStockDataFromYahoo.Class_Initialize", "Could not create WinHttp.WinHttpRequest object..."
    End If
End Sub
 

jjbungles

New Member
Joined
May 8, 2008
Messages
33
I found a solution to getting the historical data for ^DJI and EURUSD=X symbols from yahoo finance. It seems that DIYTraders.com has a historical macro (similar to Tom's above) that downloads the data to a separate file (and I need in on the same worksheet - HELP Please?). As I look at Tom's Macro above and compare it to the DIYTraders.com Macro they used different methods for getting what I think is a CSV file.

Tom uses WinHttp.WinHttpRequest
DIYTraders uses Microsoft.XMLHTTP

Being an absolute novice, I have tried to find out what each of these(object/method/function/property?) are, how they work and why/when to use them.

As the Microsoft.XMLHTTP seems to work for all the tickers Yahoo finance supports, how do I modify Toms code above to include this alternate method yet write the results in the same worksheet like Tom's does?

Sorry - THIS TEXT GOES ABOVE THE TWO LISTS OF CODE IN THE RESPONSE ABOVE.

Please forgive my ignorance but I have trolled the web/VBA help files etc. for days to understand whats going on. If any one can help or point me in the right direction that would be great. I got confused because I believe that yahoo finance is providing a csv file, yet both macros go to great lengths to reparse the data and get it into excel. The DIYTraders.com macro seems to ask for a table.csv, put it into a .txt file then transpose to a .csv then to an .xls file. This confuses me. Can anyone explain this? :confused:

I have included the download Sub below from DIY.Traders.com so you can compare.

(With hat in hand...) Can anyone please help me?
 

Forum statistics

Threads
1,081,793
Messages
5,361,316
Members
400,625
Latest member
Asraful Alam

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top