Question

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

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

有人能帮助我吗？感谢

Answer 1

如果我必须这样做，我的第一个问题是：是否没有其他可能直接获取数据？生成此HTML和JavaScript的服务器还必须从其他地方获取数据。所以最好的解决方案是，如果你能从服务器获得与源相同的数据。例如，作为XML。有许多直接的解决方案可以将XML导入Excel。

如果无法做到这一点，那么您将需要一个可以渲染此脚本生成HTML的浏览器。幸运的是，使用VBA，您可以自动化InternetExplorer。

要使用此代码，您必须在VBA中提供一些引用。为此：

在VBA编辑器中，从菜单栏中选择工具/参考。
选择“Microsoft Internet Controls”
选择“Microsoft Forms 2.0 Object Library”或将UserForm插入你的VBA项目
选择“Microsoft HTML Object Library”

代码属于模块。

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

Startpoint是getWebContentMain。

此代码将使用“Internet选项”中设置的“Web内容区域”的安全设置启动Internet Explorer。因此必须启用“Active Scripting”才能在网页上运行JavaScript。

10秒后，它将从不断变化的网页中获取第一个快照。然后它将每5秒拍摄一次快照。

如果您关闭浏览器，但代码以错误结束，但最后一个快照仍然保留。如果您关闭工作簿，它也会结束。

在某些情况下，您的IE可能会在POST请求后使用凭据标记.Busy和.ReadyState。如果代码尝试获取.Document，则会出现错误。在这种情况下，请增加第一个Application.OnTime命令的时间值。

问候

阿克塞尔

从用脚本编写的网页将数据导入excel

1 个答案: