將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