メモ

主にプログラミング系の備忘録

*VBAでDOM っぽいことを

Option Compare Database

Public Sub testNodeTree()
  Dim hdoc As MSHTML.HTMLDocument
  Dim objIE As InternetExplorer
  Dim obj As Object
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim rsatt As DAO.Recordset
  Dim buf As Variant
  
  On Error GoTo 0
  Set db = CurrentDb
  Set rs = db.OpenRecordset("T_DOM")
  Set rsatt = db.OpenRecordset("M_attr")
  
  
  
  Set objIE = New InternetExplorer  'IEオブジェクト生成
  objIE.Visible = True              'IEオブジェクトを可視に
  objIE.Navigate "http://yahoo.co.jp" '開きたいサイトのURLを指定
      
  Call WaitIE(objIE)

  Set hdoc = objIE.Document
  For Each obj In hdoc.all
  If obj.nodeType = 1 Then
'    If obj.getAttribute("id") = "nsi-body" Then Stop
    rs.AddNew
    rs.Fields("tagname") = obj.tagName
    rs.Fields("uniqueID") = obj.uniqueNumber
'Stop
    If IsNull(obj.parentElement) = False Then
    If obj.parentElement Is Nothing = False Then rs.Fields("parentID") = obj.parentNode.uniqueNumber
    End If
'    On Error GoTo OF
'    Debug.Print obj.uniqueNumber, Len(obj.innerText), obj.innerText
    buf = obj.innerText
    rs.Fields("innerText") = buf
    On Error GoTo 0
    rsatt.MoveFirst
    Do Until rsatt.EOF
      If obj.tagName <> "iframe" Or rsatt.Fields(0).Value <> "type" Then
     ' On Error Resume Next
      rs.Fields("a_" & rsatt.Fields(0).Value) = obj.getAttribute(rsatt.Fields(0).Value)
      End If
      On Error GoTo 0
      rsatt.MoveNext
    Loop
    rs.Update
  End If

  Next obj

Exit Sub

OF:
  Select Case Err.Number
    Case 3163
      Resume Next
    Case Else
      Stop
  End Select
    


End Sub