Sub Get_Web() 'На примере http://finance.yahoo.com
Dim DATA As String, XMLHTTP As Object
Dim URL As String
URL = "http://finance.yahoo.com/q/hp?s=%5EDJI&a=08&b=01&c=2013&d=10&e=7&f=2014&g=d"       
Set XMLHTTP = CreateObject("MSXML2.XMLHTTP") 'CreateObject("Microsoft.XMLHTTP")
        With XMLHTTP
            .Open "GET", URL, False         
            .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
Debug.Print DATA       

Set XMLHTTP = Nothing
End Sub

Sub POST_Web() 'На примере  http://ru.investing.com
Dim DATA As String, XMLHTTP As Object
Const URL As String = "http://ru.investing.com/instruments/HistoricalDataAjax"
Dim CurrId As String, dateFrom As String, dateTo As String, Interval As String

CurrId = "166": dateFrom = "01/11/2014": dateTo = "10/11/2014": Interval = "Daily"

Set XMLHTTP = CreateObject("MSXML2.XMLHTTP") 'CreateObject("Microsoft.XMLHTTP")
With XMLHTTP
        .Open "POST", URL, False
        .setRequestHeader "Accept", "text/plain, */*; q=0.01"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .setRequestHeader "Host", "ru.investing.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 "action=historical_data & curr_id=" & CurrId & "& st_date=" & dateFrom & "& end_date=" & dateTo & "& interval_sec=" & Interval & ""
End With
              
        DATA = XMLHTTP.responseText
        Debug.Print DATA
              
Set XMLHTTP = Nothing
'INVESTING.COM. СТРУКТУРА ЗАПРОСА:       
'============================================================================
'http://ru.investing.com/instruments/HistoricalDataAjax
'action:       historical_data
'curr_id:     166  'КОД ФИНАНСОВОГО ИНСТРУМЕНТА
'st_date:     07/10/2014   st_date:  07%2F10%2F2014 'ДАТА НАЧАЛА ПЕРИОДА ЗАГРУЗКИ       
'end_date:  06/11/2014   end_date: 06%2F11%2F2014 'ДАТА ОКОНЧАНИЯ ПЕРИОДА ЗАГРУЗКИ
'interval_sec: Daily ' ТАЙМФРЕЙМ
'------------------------------------------------------------------------------------------------------------------------------------------
'action=historical_data&curr_id=166&st_date=07%2F10%2F2014&end_date=06%2F11%2F2014&interval_sec=Daily
'оригинальная ссылка
'------------------------------------------------------------------------------------------------------------------------------------------
'"action=historical_data & curr_id=" & CurrId & "& st_date=" & dateFrom & "& end_date=" & dateTo & "& interval_sec=" & Interval & ""
'сформированная с наличием переменных
'=============================================================================
End Sub

Private Sub Get_List_FAQ()
Dim NextRow As Long, objHTML As Object, aTable As Object, URL As String
Dim TB, DATA As String

Application.ScreenUpdating = False

URL = "http://www.msoffice.nm.ru/faq/macros.htm" 'FAQ макросы
DATA = List_FAQ(URL) 'получаем код страницы через функцию List_FAQ

Cells.Delete

Set objHTML = CreateObject("htmlfile")
      objHTML.write DATA

Set aTable = objHTML.GetElementsByTagName("ol").Item(0)

    For Each TB In aTable.all 'перебираем все теги, исключая ненужные (<A>, <SUP>, <STRONG>)
        NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
        If TB.nodeName <> "A" And TB.nodeName <> "SUP" And TB.nodeName <> "STRONG" Then
           
          Select Case TB.nodeName
             Case "B" 'ИЗВЛЕКАЕМ ЗАГОЛОВОК ТЕМЫ
               With Cells(NextRow, 1)
                   .Value = Replace(TB.innerText, vbCrLf, "")
                   .Font.Color = RGB(153, 0, 0)
                   .Font.Size = 13
                   .Font.Bold = True
               End With
        
             Case Else 'ИЗВЛЕКАЕМ ВСЕ ВОПРОСЫ В КАЖДОЙ ТЕМЕ
                Cells(NextRow, 1) = Replace(TB.innerText, vbCrLf, "") 'УБИРАЕМ В СТРОКЕ ПЕРЕНОС, ЧТОБЫ СТРОКА БЫЛА ЕДИНОЙ
        
             If Len(TB.innerText) > 0 Then
                ActiveSheet.Hyperlinks.Add Anchor:=Cells(NextRow, 1), _
                Address:="http://www.msoffice.nm.ru/faq/" & Split(TB.innerHTML, """")(1), _
                ScreenTip:="Перейти на сайт"
             End If
               
          End Select
        End If
          
    Next TB

Set objHTML = Nothing
Application.ScreenUpdating = True
End Sub