從寫入腳本的網頁將數據導入到excel中

我試圖從網頁導入實時數據。然而，網頁似乎是用腳本編寫的，所以我似乎無法將數據導入到excel中。我想運行一個宏。我做了一個搜索，發現以下線程非常有用; Import Data in Excel from a table created by a script in a WebPage（第一回答）從寫入腳本的網頁將數據導入到excel中

但我沒有足夠的知識來調整我的網站的代碼？

有人可以幫助我嗎？謝謝

來源

2014-09-01 Zara Mazhar

如果我必須這樣做，我的第一個問題是：是否沒有另一種可能性直接獲取數據？生成此HTML和JavaScript的服務器還必須從其他位置獲取數據。所以最好的解決方案是，如果你能得到與服務器相同的數據源。例如XML。有很多簡單的解決方案可以將XML轉換爲Excel。

如果這是不可能的，那麼你將需要一個瀏覽器，它可以使這個腳本生成HTML。幸運的是，使用VBA可以使InternetExplorer實現自動化。

要使用此代碼，您必須在VBA中提供一些參考。要做到這一點：

在VBA編輯器中，從菜單欄中選擇工具/參考。
選擇「Microsoft Internet控制」
選擇「Microsoft窗體2.0對象庫」，或插入用戶窗體到您的VBA項目
選擇「Microsoft HTML對象庫」

的代碼屬於成模塊。

Option Explicit 
Private oBrowser As InternetExplorer 

Private Sub openBrowserAndLogin() 
Set oBrowser = New InternetExplorer 

With oBrowser 
    .Visible = True 
    .navigate "http://rtm-test.nexala.com/fleet" 

    Do While .Busy Or .ReadyState <> READYSTATE_COMPLETE 
    DoEvents 
    Loop 

    On Error Resume Next 
    With .Document.forms("spectrumLoginForm") 
    .elements("j_username").Value = "test" 
    .elements("j_password").Value = "***" 
    .submit 
    End With 
    On Error GoTo 0 

    Do While .Busy Or .ReadyState <> READYSTATE_COMPLETE 
    DoEvents 
    Loop 
End With 
End Sub 

Private Function takeSnapshot() As String 
Dim oTables As IHTMLElementCollection 
Dim oTable As IHTMLElement 
Dim sTableHTML As String 
With oBrowser 
    Set oTables = .Document.getElementByID("fleetGrid").getElementsByTagName("table") 
    Set oTable = oTables(1) 
    sTableHTML = oTable.innerHTML 
End With 
takeSnapshot = sTableHTML 
End Function 

Private Sub getWebContentOnTime() 
Dim oHTMLDoc As IHTMLDocument 
Dim oTable As IHTMLElement 
Dim oTR As IHTMLTableRow 
Dim oCell As IHTMLTableCell 
Dim oWS As Worksheet 
Dim oClip As DataObject 
Dim sTableHTML As String 
Dim sDivClassName As String 
Dim aClassProps As Variant 
Dim dTime As Double 
Dim lRows As Long 
Dim lCols As Long 
Dim lColsRow As Long 


sTableHTML = takeSnapshot() 

Set oHTMLDoc = New HTMLDocument 
oHTMLDoc.body.innerHTML = "<html><table id=""t1"">" & sTableHTML & "</table></html>" 

Set oTable = oHTMLDoc.getElementByID("t1") 
lRows = 0 
lCols = 0 
For Each oTR In oTable.Rows 
    lColsRow = 0 
    For Each oCell In oTR.Cells 
    sDivClassName = oCell.FirstChild.className 
    aClassProps = Split(sDivClassName, "_") 
    If aClassProps(0) = "fleet" Then 
    On Error Resume Next 
    oCell.Style.backgroundColor = aClassProps(1) 
    oCell.Style.Color = aClassProps(2) 
    On Error GoTo 0 
    End If 
    lColsRow = lColsRow + 1 
    Next 
    If lColsRow > lCols Then lCols = lColsRow 
    lRows = lRows + 1 
Next 

Set oClip = New DataObject 
oClip.SetText "<html><table>" & oTable.innerHTML & "</table></html>" 
oClip.PutInClipboard 

Set oWS = ThisWorkbook.Worksheets(1) 
oWS.Paste Destination:=oWS.Range(oWS.Cells(1, 1), oWS.Cells(lRows, lCols)) 

dTime = Now + TimeSerial(0, 0, 5) 
Application.OnTime EarliestTime:=dTime, _ 
     Procedure:="getWebContentOnTime", _ 
     Schedule:=True 

End Sub 

Public Sub getWebContentMain() 
Dim dTime As Double 

Call openBrowserAndLogin 

dTime = Now + TimeSerial(0, 0, 10) 
Application.OnTime EarliestTime:=dTime, _ 
     Procedure:="getWebContentOnTime", _ 
     Schedule:=True 

End Sub

起點是getWebContentMain。

此代碼將使用在「Internet選項」中設置的「Web內容區域」的安全設置來啓動Internet Explorer。所以必須啓用「Active Scripting」才能在網頁上運行JavaScript。

10秒鐘後，它會從連續變化的網頁中獲取第一個快照。然後它會每隔5秒拍攝一次快照。

如果關閉瀏覽器，但最後的快照仍然保留，則代碼以錯誤結尾。如果關閉工作簿，它也會結束。

在某些情況下，您的IE不會標記.Busy和.ReadyState POST憑證後的請求正確。然後，如果代碼嘗試獲取.Document，則會出現錯誤。在這種情況下，增加第一個Application.OnTime命令的時間值。

問候

阿克塞爾

來源

2014-09-02 15:51:40

我明白了。你可以刪除你的文章或編輯登錄詳細信息？謝謝 – 2015-01-30 15:09:27

從寫入腳本的網頁將數據導入到excel中

回答

相關問題