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

我正在尝试从网页导入实时数据。 然而,网页似乎是写在脚本中,所以我似乎无法将数据导入到Excel中。 我试图运行一个macros。 我做了一个search,发现以下线程非常有用; 从WebPage中的脚本创build的表中导入Excel中的数据 (第一个答案)

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

有人能帮我吗? 谢谢

如果我必须这样做,我的第一个问题是:是否没有另外的可能性直接获取数据? 生成这个HTML和JavaScript的服务器也必须从别处获取数据。 所以最好的解决办法是,如果你能得到与服务器相同的数据源。 例如XML。 有很多简单的解决scheme可以将XML转换成Excel。

如果这是不可能的,那么你将需要一个浏览器,可以使这个脚本生成HTML。 幸运的是,使用VBA,您可以自动运行InternetExplorer。

要使用此代码,您必须在VBA中提供一些参考。 要做到这一点:

  • 在VBA编辑器中,从菜单栏中selectTools / References。
  • select“Microsoft Internet Controls”
  • select“Microsoft Forms 2.0对象库”或插入用户窗体到您的VBA项目
  • select“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 

起点是getWebContentMain。

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

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

如果closures浏览器,则代码以错误结束,但最后一个快照保留。 它也结束,如果您closures工作簿。

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

问候

阿克塞尔