从特定的Table Web / VBA中删除数据

时间:2018-03-23 09:41:35

标签: excel-vba web html-table vba excel

我创建了一个从我们的企业的本地网站上抓取数据的宏 代码工作正常,但这个宏收集该页面中的所有表格以及我想要的只是收集该页面中的特定表格的问题

特定表的html代码:

      <TD width="3%">&nbsp; </TD>

    <TD colSpan=4>
     <TABLE borderColor=#ffffff cellSpacing=0 cellPadding=3 
        width="100%" border=1>
     <TBODY>
     <TR class=TableTitle1>
     <TD vAlign=middle width=90 align=left>MOD Number (CIN)</TD>
     <TD vAlign=middle width=250 align=left>Title</TD>
     <TD vAlign=middle width=90 align=left>Leader (FIC)</TD>
     <TD vAlign=middle width=49 align=left>ATA</TD>
     <TD vAlign=middle width=72 align=left>Opening MP</TD>
     <TD vAlign=middle width=88 align=left>Opening date</TD></TR>
     <TR class=TableContent>
      <TD><A href="/cmh/consultation/preViewMOD.do 
      MODId=162615&amp;mpId=K20734&amp;isFrom=fromMP">162615</A> <A 
      href="/cmh/consultation/preViewCINData.do? 
      MODId=162615&amp;MPId=K20734">(162615/K20734)</A> </TD>
      <TD>COMMUNICATIONS-PAX ENTERTAINMENT INSTALL PANASONIC EX1/EXW ON 
      UNIVERSAL PLATFORM FOR ANZ06 VERSION </TD>
      <TD>SA CCC </TD>
      <TD>2333 </TD>
      <TD><A href="/cmh/consultation/preViewMP.do? 
       mpId=K20734&amp;isFrom=fromMP">K20734</A> </TD>
      <TD>08-Aug-17 </TD></TR>
      <TR height=1 bgColor=white>
      <TD colSpan=484></TD></TR></TBODY></TABLE></TD>

我想要的是仅使用类提取该表:TableTiltle1和类:TableContent

这是我的宏VBA:

   Sub extract()

   Dim IE As Object, obj As Object
   Dim itm As IHTMLElement
   Dim r As Long, c As Long, t As Long
   Dim elemCollection As Object
   Dim eRow As Long

   'add the microsoft Internet Controls
   Set IE = CreateObject("InternetExplorer.Application")

    With IE
      .Visible = True
      .navigate "Try into another site because our site is "

       While IE.Busy Or IE.readyState <> 4: DoEvents: Wend
      'we ensure that the web Page is loaded completely
       Set itm = IE.document.getElementsByName("searchById")(0)
       If Not itm Is Nothing Then itm.Value = "k20442"
       Set doc = IE.document


       Set tags = IE.document.getElementsByTagName("input")

        For Each tagx In tags
        If tagx.src = "http://xxxxc- 
       xxxxx.airbus.xxxxxx/cmh/cmh/image/button_search.gif" Then
         tagx.Click
         End If
        Next

        On Error Resume Next
        Do While IE.Busy Or elemCollection.Length = 0
           DoEvents
        Set elemCollection = IE.document.getElementsByTagName("TABLE")
        Loop
         With ws
          Sheets("Feuil1").Range("A1:AK500").ClearContents
         End With


        For t = 0 To (elemCollection.Length - 1)
          For r = 0 To (elemCollection(t).Rows.Length - 1)
            For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)

       With ws
       Sheets("Feuil1").Cells(r + 1, c + 1) = 
       elemCollection(t).Rows(r).Cells(c).innerText
       DoEvents
      End With

      Next c
     Next r
    Next t

    End With
    IE.Quit
    Set IE = Nothing
    MsgBox "Done"
 End Sub

任何人都可以解雇我

1 个答案:

答案 0 :(得分:1)

试试这个:

Dim oHtml       As HTMLDocument
Dim elemCollection    As Object

While IE.Busy Or IE.readyState <> 4: DoEvents: Wend

Set oHtml = New HTMLDocument
oHtml.Body.innerhtml = ie.Document.Body.innerhtml

Set elemCollection = oHtml.getElementsByClassName("TableTiltle1") 'or TableContent

确保添加对Microsoft HTML Object Library

的引用