Private Type Finance_yahoo
    Date_ As Variant
    Open_ As Double
    High As Double
    Low As Double
    Close_ As Double
    Volume As Double
    AdjClose As Double

End Type
Sub Get_Web()
    Dim url As String, F_yahoo() As Finance_yahoo, X() As Variant
    ReDim F_yahoo(0)
    url = "http://finance.yahoo.com/q/hp?s=%5EDJI&a=00&b=29&c=1985&d=10&e=1&f=2014&g=d"
    Get_MMM url, F_yahoo
    X = Finance_To_Array(F_yahoo)
    Range("A2").Resize(UBound(X) + 1, UBound(X, 2) + 1) = X
End Sub

Function Finance_To_Array(ByRef X() As Finance_yahoo)
    Dim n As Long, Rz() As Variant
    ReDim Rz(UBound(X), 6)
    n = 0
    Rz(n, 0) = "Date"
    Rz(n, 1) = "Open"
    Rz(n, 2) = "High"
    Rz(n, 3) = "Low"
    Rz(n, 4) = "Close"
    Rz(n, 5) = "Volume"
    Rz(n, 6) = "Adj Close"

    For n = 1 To UBound(X)
        Rz(n, 0) = X(n).Date_
        Rz(n, 1) = X(n).Open_
        Rz(n, 2) = X(n).High
        Rz(n, 3) = X(n).Low
        Rz(n, 4) = X(n).Close_
        Rz(n, 5) = X(n).Volume
        Rz(n, 6) = X(n).AdjClose
    Next
    Finance_To_Array = Rz
End Function
Sub Get_MMM(url As String, ByRef X() As Finance_yahoo)
    Dim Data As String, papalast As Long, bRes As Boolean, RegExp As Object
    Dim XMLHTTP
    Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")    'CreateObject("MSXML2.XMLHTTP") CreateObject("Microsoft.XMLHTTP")
    With XMLHTTP
        .Open "GET", url, False    '----------------------------------------------------------------------GET  POST
        .setRequestHeader "Accept", "text/plain, */*; q=0.01"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .setRequestHeader "Host", "finance.yahoo.com"
        .setRequestHeader "Accept-Encoding", "gzip,deflate"
        .setRequestHeader "X-Requested-With", "XMLHttpRequest"
        .setRequestHeader "Accept-Language", "uk-UA,uk;q=0.8,ru;q=0.6,en-US;q=0.4,en;q=0.2,de;q=0.2"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062.103 Safari/537.36"
        .send

    End With

    Data = XMLHTTP.responseText

    bRes = False
    Set RegExp = CreateObject("VBScript.RegExp")
    RegExp.Global = True
    RegExp.IgnoreCase = True

    RegExp.Pattern = "<tr><td[^>]*>([0-9A-z,\s]+)</td>" & _
                     "<td[^>]*>([0-9\.,]+)</td>" & _
                     "<td[^>]*>([0-9\.,]+)</td>" & _
                     "<td[^>]*>([0-9\.,]+)</td>" & _
                     "<td[^>]*>([0-9\.,]+)</td><td[^>]*>([0-9\.,]+)</td><td[^>]*>([0-9\.,]+)</td>"

    bRes = RegExp.test(Data)
    If bRes Then
        Set oMatches = RegExp.Execute(Data)

        For n = 0 To oMatches.Count - 1
            papalast = UBound(X) + 1
            ReDim Preserve X(papalast)
            X(papalast).Date_ = oMatches(n).subMatches(0)
            X(papalast).Open_ = Val(Replace(oMatches(n).subMatches(1), ",", ""))
            X(papalast).High = Val(Replace(oMatches(n).subMatches(2), ",", ""))
            X(papalast).Low = Val(Replace(oMatches(n).subMatches(3), ",", ""))
            X(papalast).Close_ = Val(Replace(oMatches(n).subMatches(4), ",", ""))
            X(papalast).Volume = Val(Replace(oMatches(n).subMatches(5), ",", ""))
            X(papalast).AdjClose = Val(Replace(oMatches(n).subMatches(6), ",", ""))


        Next
    End If
    RegExp.Pattern = "next"" href=""(/q/hp(.+?)y=(\d+))"">Next</a>"

    bRes = RegExp.test(Data)
    If bRes Then
        Set oMatches = RegExp.Execute(Data)
        url = "http://finance.yahoo.com" & Replace(oMatches(0).subMatches(0), "&amp;", "&")
       Get_MMM url, X

    End If

End Sub