Извлечение данных URL в Excel

Question

Можно ли написать макрос, чтобы открыть URL-адрес, скопировать с него данные и вставить в электронную таблицу Excel?

Answer 1

Это действительно зависит от того, где данные находятся в URL. Ниже приведен пример получения информации о ценах на топливо. Просмотрите веб-сайт и поместите его в макрос и посмотрите, как он работает в Excel.

Sub WEB_WEEKLY_DOE_VALUE1()
Dim LROWA As Integer, LROWB As Integer
Dim oIE As SHDocVw.InternetExplorer
Dim sPage As String
Dim iQuote1 As Double, iDec1 As Double
Dim iStart1 As Double, iEnd1 As Double
Dim dQuote1 As Double
  Dim iQuote2 As Double, iDec2 As Double
  Dim iStart2 As Double, iEnd2 As Double
  Dim dQuote2 As Double
  On Error Resume Next


  str1 = Right(Year(Now()), 2)
  str2 = Month(Now())
  If Len(str2) = 1 Then
  str2 = "0" & str2
  End If
  str3 = Day(Now())
  If Len(str3) = 1 Then
  str3 = "0" & str3
  End If


  strLatestDate = "100517"
  str2ndLatestDate = "100510"



  Set oIE = New SHDocVw.InternetExplorer
  oIE.Navigate "http://www.eia.doe.gov/oog/info/wohdp/List_Serve_report_All.txt"
  Do Until oIE.ReadyState = READYSTATE_COMPLETE
    DoEvents
  Loop
  sPage = oIE.Document.Body.InnerHTML





  'New Weekly Date Set
  iQuote1 = InStr(1, sPage, strLatestDate, vbTextCompare)

  'US National Avg
  iDec1 = InStr(iQuote1, sPage, ".", vbTextCompare)
  iStart1 = InStrRev(sPage, "  ", iDec1) + 1
  iEnd1 = InStr(iDec1, sPage, "  ")
  dQuote1 = Val(Mid(sPage, iStart1, iEnd1 - iStart1))

  'East Coast Padd I
  iDec1 = InStr(iDec1 + 1, sPage, ".", vbTextCompare)
  iStart1 = InStrRev(sPage, "  ", iDec1) + 1
  iEnd1 = InStr(iDec1, sPage, "  ")
  dQuote2 = Val(Mid(sPage, iStart1, iEnd1 - iStart1))

    'New England Padd IA
  iDec1 = InStr(iDec1 + 1, sPage, ".", vbTextCompare)
  iStart1 = InStrRev(sPage, "  ", iDec1) + 1
  iEnd1 = InStr(iDec1, sPage, "  ")
  dQuote3 = Val(Mid(sPage, iStart1, iEnd1 - iStart1))

    'Central Padd IB
  iDec1 = InStr(iDec1 + 1, sPage, ".", vbTextCompare)
  iStart1 = InStrRev(sPage, "  ", iDec1) + 1
  iEnd1 = InStr(iDec1, sPage, "  ")
  dQuote4 = Val(Mid(sPage, iStart1, iEnd1 - iStart1))

    'Lower ATL Padd IC
  iDec1 = InStr(iDec1 + 1, sPage, ".", vbTextCompare)
  iStart1 = InStrRev(sPage, "  ", iDec1) + 1
  iEnd1 = InStr(iDec1, sPage, "  ")
  dQuote5 = Val(Mid(sPage, iStart1, iEnd1 - iStart1))

    'MidWest Padd II
  iDec1 = InStr(iDec1 + 1, sPage, ".", vbTextCompare)
  iStart1 = InStrRev(sPage, "  ", iDec1) + 1
  iEnd1 = InStr(iDec1, sPage, "  ")
  dQuote6 = Val(Mid(sPage, iStart1, iEnd1 - iStart1))

    'Gulf Coast Padd III
  iDec1 = InStr(iDec1 + 1, sPage, ".", vbTextCompare)
  iStart1 = InStrRev(sPage, "  ", iDec1) + 1
  iEnd1 = InStr(iDec1, sPage, "  ")
  dQuote7 = Val(Mid(sPage, iStart1, iEnd1 - iStart1))

    'Rocky Mtn Padd IV
  iDec1 = InStr(iDec1 + 1, sPage, ".", vbTextCompare)
  iStart1 = InStrRev(sPage, "  ", iDec1) + 1
  iEnd1 = InStr(iDec1, sPage, "  ")
  dQuote8 = Val(Mid(sPage, iStart1, iEnd1 - iStart1))

    'West Coast Padd V
  iDec1 = InStr(iDec1 + 1, sPage, ".", vbTextCompare)
  iStart1 = InStrRev(sPage, "  ", iDec1) + 1
  iEnd1 = InStr(iDec1, sPage, "  ")
  dQuote9 = Val(Mid(sPage, iStart1, iEnd1 - iStart1))

    'California
  iDec1 = InStr(iDec1 + 1, sPage, ".", vbTextCompare)
  iStart1 = InStrRev(sPage, "  ", iDec1) + 1
  iEnd1 = InStr(iDec1, sPage, str2ndLatestDate)
  dQuote10 = Val(Mid(sPage, iStart1, iEnd1 - iStart1))

  Sheet1.Range("A1") = dQuote1
  Sheet1.Range("B1") = dQuote2
  Sheet1.Range("C1") = dQuote3
  Sheet1.Range("D1") = dQuote4
  Sheet1.Range("E1") = dQuote5
  Sheet1.Range("F1") = dQuote6
  Sheet1.Range("G1") = dQuote7
  Sheet1.Range("H1") = dQuote8
  Sheet1.Range("I1") = dQuote9
  Sheet1.Range("J1") = dQuote10

  oIE.Quit


  End Sub