使用VBA Excel从embedded式网页提取数据

我正尝试在Excel中使用VBA来访问embedded在网页中的网页中的数据。 我知道如何做到这一点，如果表是在一个非embedded式的页面。 我也知道如何使用VBA导航到该产品的页面。 我不能导航到embedded式页面，因为有一个产品ID查找，将零件号码转换为ID，我没有访问该数据库。

以下是该页面的链接： http : //support.automation.siemens.com/WW/view/en/7224052

我会提出清晰的元素的图片，但我没有10个重点…

我需要获取信息的表格是“产品生命周期”表格。

如果我使用下面的代码将页面保存为VBA中的HTMLDocument，则可以在相应的项目下的src属性中看到正确的url：

For Each cell In Selection link = "http://support.automation.siemens.com/US/llisapi.dll?func=cslib.csinfo&lang=en&objid=" & cell & "&caller=view" ie.navigate link Do DoEvents Loop Until ie.readyState = READYSTATE_COMPLETE Dim doc As HTMLDocument 

有没有办法用VBA索引这个表格，或者我需要联系公司并尝试访问产品ID，以便我可以直接导航到页面？

关于我下面的评论，这是一个录制的macros的代码：

 ActiveCell.FormulaR1C1 = _ "http://support.automation.siemens.com/WW/llisapi.dll?func=cslib.csinfo&lang=en&objid=6ES7194-1AA01-0XA0&caller=view" Range("F9").Select With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://support.automation.siemens.com/WW/llisapi.dll?func=ll&objid=7224052&nodeid0=10997566&caller=view&lang=en&siteid=cseus&aktprim=0&objaction=csopen&extranet=standard&viewreg=WW" _ , Destination:=Range("$F$9")) .FieldNames = True .RowNumbers = False 

我知道在哪里可以findstring： URL;http://support.automation.siemens.com/WW/llisapi.dll?func=ll&objid=7224052&nodeid0=10997566&caller=view&lang=en&siteid=cseus&aktprim=0&objaction=csopen&extranet=standard&viewreg=WW ，但我不知道如何将其保存到一个variables。

Answer 1

不知道我完全理解你的问题，但是这里有一些代码将得到感兴趣的表格后面的源代码。 您可以使用“instr”和“mid”等函数提取感兴趣的数据

 ' open IE, navigate to the website of interest and loop until fully loaded Set ie = CreateObject("InternetExplorer.Application") With ie .Visible = True .navigate "http://support.automation.siemens.com/WW/view/en/7224052" .Top = 50 .Left = 530 .Height = 400 .Width = 400 Do Until Not ie.Busy And ie.ReadyState = 4 DoEvents Loop End With ' Assign the source code behind the page to a variable my_var = ie.document.frames(3).document.DocumentElement.innerhtml ' Extract the url for the "Product life cycle" table pos_1 = InStr(1, my_var, "product life cycle", vbTextCompare) pos_2 = InStr(pos_1, my_var, "/WW/llisapi", vbTextCompare) pos_3 = InStr(pos_2, my_var, """><", vbTextCompare) pos_4 = InStr(pos_3, my_var, """/>", vbTextCompare) table_url = Mid(my_var, pos_2, pos_3 - pos_2) table_url = Replace(table_url, "amp;", "", 1, -1, vbTextCompare) table_url = "http://support.automation.siemens.com" & table_url ' navigate to the table url ie.navigate table_url Do Until Not ie.Busy And ie.ReadyState = 4 DoEvents Loop ' assign the source code for this page to a variable and extract the desired information my_var2 = ie.document.body.innerhtml pos_1 = InStr(1, my_var2, "ET 200X, basic modules,", vbTextCompare) ' close ie ie.Quit 

Answer 2

我有问题得到ron的代码工作，我认为，因为IE浏览器不能轻松使用框架。 下面是一些代码，将从表中提取一些数据，到目前为止不处理图表。

 Sub FrameStrip() Dim oFrames As Object Dim tdelements As Object Dim tdElement As Object Dim oFrame As MSHTML.HTMLFrameElement Dim oElement As Object Dim sString As String Dim myVar As Variant Dim sLinks() As String Dim i As Integer Dim bfound As Boolean Dim url As String Dim oIE As InternetExplorer Set oIE = New InternetExplorer url = "http://support.automation.siemens.com/WW/view/en/7224052" 'Set address for use with relative source names myVar = Split(url, "/") sString = myVar(0) & "//" & myVar(2) oIE.navigate url oIE.Visible = True Do Until (oIE.readyState = 4 And Not oIE.Busy) DoEvents Loop Set oFrames = oIE.document.getElementsByTagName("frame") ReDim sLinks(oFrames.Length) 'Get the source locations for each frame i = 0 For Each oFrame In oFrames sLinks(i) = sString & (oFrame.getAttribute("src")) i = i + 1 Next oFrame 'Go through each frame to find the table i = 0 bfound = False Do While i < UBound(sLinks) And bfound = False oIE.navigate sLinks(i) Do Until (oIE.readyState = 4 And Not oIE.Busy) DoEvents Loop Set oElement = oIE.document.getElementById("produktangaben") bfound = IsSet(oElement) i = i + 1 Loop Set tdelements = oElement.getElementsByTagName("td") 'Display information about table sString = "" For Each tdElement In tdelements Debug.Print tdElement.innerText sString = sString & tdElement.innerText Next tdElement End Sub Function IsSet(ByRef oElement As Object) As Boolean Dim tdelements As Object Dim bSet As Boolean bSet = True On Error GoTo ErrorSet Set tdelements = oElement.getElementsByTagName("td") On Error GoTo 0 Cleanup: On Error Resume Next Set tdelements = Nothing On Error GoTo 0 IsSet = bSet Exit Function ErrorSet: bSet = False GoTo Cleanup: End Function