将 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