FC2ブログ

EXCELのVBAでIEをコントロールその2

さて前回は
EXCELのVBAでIEをコントロールその1
http://hymandr1200st.blog.fc2.com/blog-entry-1161.html
にて

>DOM要素の分析ロジックソースについては
>もう少しこなれてからご報告する
としました

今回は、この分析の部分をアップしておきます

使い方を先に書いておきます
前回のソースの
'-----編集したのはここだけ
'取得したダイヤログウインドウのID「OKButton」をクリック
objDocument.getElementById("OKButton").Click
'-----編集したのはここまで

この部分を以下のように変更します
'-----編集したのはここだけ
Call DOMAnalyze(objDocument, "分析") '分析の部分は実在するワークシート名にしてください
'-----編集したのはここまで

説明はソースのコメントを読んでください

( ̄ー ̄)/~~ジャ


以下、モジュールに追加するソース
'--------------------------------------------------------------------------------------------
' DOM分析
'--------------------------------------------------------------------------------------------
Sub DOMAnalyze(prmDoc As Object, prmWS As String)
'第1引数:HTMLDocument
'第2引数:出力先ワークシート名
'
'【概要】
'DOMによるIEの操作にあたり、そのウインドウにどんなItemがあるのかを調べWorkSheetに記録します
'操作する対象を絞るにはItemインデックスのほかIDやclassnameなどもあります
'対象を確実に絞り込むことができるアプローチとしてはIDが優位ですがすべてのItemにIDが付されている
'とは限りません。そこでcalssnameやNameやTagNameを利用することになりますが、これらは
'同じ名称のものが複数存在する場合があり、絞り込みには添え字が必要です
'本件処理では、さしあたって必要と思われるこれらの要素をワークシートに出力します
'各Itemの持つ子要素数は親子関係の位置が「特定」できる場合に利用するとよいでしょう
'また、各ItemのHTMLテキストは先頭255文字を出力していますが、適宜修正してください
'
Dim WS As Worksheet '出力ワークシート
Dim objItem As Object 'ドキュメントのItem
Dim objCollection As Object 'Itemの属するコレクションを作成
Dim i As Long 'ドキュメントのItem添え字
Dim j As Long '出力ワークシートの行制御
Dim k As Long 'Itemの属するコレクションを作成しn番目かを調べる
Dim MSG As String 'エラーメッセージ

If prmDoc Is Nothing Then
MsgBox "IEが取得できていません"
Exit Sub
End If

Set WS = Worksheets(prmWS) '出力ワークシート

WS.Range("A:J").Clear '出力ワークシート初期化
WS.Cells(1, "A").Value = "Item(idx)"
WS.Cells(1, "B").Value = "ID"
WS.Cells(1, "C").Value = "ClassName"
WS.Cells(1, "D").Value = "ClassName(idx)"
WS.Cells(1, "E").Value = "Name"
WS.Cells(1, "F").Value = "Name(i)"
WS.Cells(1, "G").Value = "TagName"
WS.Cells(1, "H").Value = "TagName(idx)"
WS.Cells(1, "I").Value = "子要素数"
WS.Cells(1, "J").Value = "内容"

For i = 0 To (prmDoc.all.Length - 1)

Set objItem = prmDoc.all.Item(i)
j = i + 2 '出力ワークシート行設定
WS.Cells(j, "A").Value = i 'ItemのIdx
WS.Cells(j, "B").Value = objItem.ID 'ItemのID

'以下のエラーハンドラはclassnameやNameが定義されていない場合を想定
'TagNameは絶対あるよね(笑)

'classnameの取得
On Error GoTo ErrorHandler
WS.Cells(j, "C").Value = objItem.classname
On Error GoTo 0
If WS.Cells(j, "C").Value <> "" Then
Set objCollection = prmDoc.getElementsByclassName(objItem.classname)
For k = 0 To objCollection.Length - 1
If objCollection(k).uniqueNumber = objItem.uniqueNumber Then
WS.Cells(j, "D").Value = k
Exit For
End If
Next
End If

'Nameの取得
On Error GoTo ErrorHandler
WS.Cells(j, "E").Value = objItem.Name
On Error GoTo 0
If WS.Cells(j, "E").Value <> "" Then
Set objCollection = prmDoc.getElementsByName(objItem.Name)
For k = 0 To objCollection.Length - 1
If objCollection(k).uniqueNumber = objItem.uniqueNumber Then
WS.Cells(j, "F").Value = k
Exit For
End If
Next
End If

'tagNameの取得
On Error GoTo ErrorHandler
WS.Cells(j, "G").Value = objItem.tagName
On Error GoTo 0
If WS.Cells(j, "G").Value <> "" Then
Set objCollection = prmDoc.getElementsBytagName(objItem.tagName)
For k = 0 To objCollection.Length - 1
If objCollection(k).uniqueNumber = objItem.uniqueNumber Then
WS.Cells(j, "H").Value = k
Exit For
End If
Next
End If

WS.Cells(j, "I").Value = objItem.ChildNodes.Length '子要素数
WS.Cells(j, "J").Value = Left(objItem.outerHTML, 255) 'HTMLの先頭255文字
Next

WS.Range("A:J").WrapText = False '出力先シートの調整

Closer: '終了時またはエラー処理から復帰してObjectの廃棄
Set WS = Nothing
Set objItem = Nothing
Set objCollection = Nothing

Exit Sub
'--------------------------------------------------------
ErrorHandler: ' エラー処理ルーチン。

Select Case Err.Number ' エラー番号を評価します。
Case 438
MSG = "エラー番号 " & Str(Err.Number) & Err.Source & _
" でエラーが発生しました。" & Chr(13) & Err.Description
'Debug.Print msg
Resume Next
Case Else ' 他のエラー処理をここに記述します。
MSG = "エラー番号 " & Str(Err.Number) & Err.Source & _
" でエラーが発生しました。" & Chr(13) & Err.Description
MsgBox MSG, , "エラー", Err.HelpFile, Err.HelpContext
Resume Closer 'この処理を終了してObjectの廃棄へ復帰
End Select
End Sub
関連記事
スポンサーサイト

コメントの投稿

非公開コメント

おもちゃ箱
Count from 2010/01/14

にほんブログ村 バイクブログ ドゥカティへ


カレンダー
11 | 2018/12 | 01
- - - - - - 1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31 - - - - -
最新記事
最新コメント
カテゴリ
月別アーカイブ
リンク
検索フォーム
RSSリンクの表示
ブロとも申請フォーム

この人とブロともになる

全記事表示リンク

全ての記事を表示する