从写入脚本的网页将数据导入到excel中

问题描述：

我试图从网页导入实时数据。然而，网页似乎是用脚本编写的，所以我似乎无法将数据导入到excel中。我想运行一个宏。我做了一个搜索，发现以下线程非常有用; Import Data in Excel from a table created by a script in a WebPage（第一回答）从写入脚本的网页将数据导入到excel中

但我没有足够的知识来调整我的网站的代码？

有人可以帮助我吗？谢谢

答

如果我必须这样做，我的第一个问题是：是否没有另一种可能性直接获取数据？生成此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命令的时间值。

问候

阿克塞尔

我明白了。你可以删除你的文章或编辑登录详细信息？谢谢 – 2015-01-30 15:09:27

从写入脚本的网页将数据导入到excel中

相关推荐