Do I Use WinHttp.WinHttpRequest or Microsoft.XMLHTTP?

J

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
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
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?
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
VBA to export recurring meeting data
Replies
1
Views
1K
John_w
J
B
  • Question Question
How do I export charts based on conditions to PDF using VBA?
Replies
1
Views
947
John_w
J
V
  • Question Question
VBA help - yahoo finance downloader
2 3
Replies
20
Views
4K
johnnyL
J
S
  • Question Question
VBA help - yahoo finance downloader
Replies
8
Views
7K
vishu
V
M
  • Question Question
I need help with this code to modify the data into a table using Userform for VBA Excel (I want to do the range unlimited instead to do C7:C80000
Replies
5
Views
639
Dan_W
D

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top