関連リンク 2008/02/04: [三流君CODEのゴミ箱: VBA IE操作 リンクの取り出し と ダウンロード IE6+Excel2003] ←ダウンロードとの組み合わせとサンプルファイルです。サンプルにキレがないけど こちらも合わせてみてください
<IE操作 リンク先を取出す .Document.links(i).href>
こんにちは、三流プログラマーKen3です。 今回は、 IEで表示したURLのリンク先を取得したい です。/* * 1.今回のキッカケ */
前回の発行で、いろいろとIEの中身をいやらしく探ってたので、 自動巡回ソフト?の前準備、探りとして、 今回は、IEで表示したページのリンクを探りたいと思います。 将来的には、自動エロ画像収集巡回、自動クリック、自動チケットアタック を作りたいですね。 えっ、動機が不純だって? 不純な動機ほど気合が入るんですよ(それは変わり者のKen3だけかな?)/* * 2.またまた、IEオブジェクトの中身を探れ(手ごわい彼女の心の中?) */
[No.52 InternetExplorer.application .document.body.innerText] ( http://www.ken3.org/backno/backno_vba11.html#52 を参照) では、 彼女(オブジェクト)の中身を探る方法を少し書きました。 それにしても、階層が深いです。 テーブル系のオブジェクトを探すが、なかなか見つからない。 (女の子じゃなくって、IEの心の中は複雑なのね、、、) 前回と同じ台詞でつまらないよ。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 探り方がわかれば、あとは応用なので。 街中のナンパ同様、一回成功すれば、あとは応用なので と、成功したこと無い私が書いても説得力無いけど(笑) いつもの、馬鹿な前置きは置いといて、 いやらしい目で頭から探っていくと(ほんとは真剣な目ですよ) デバックで止めて、変数の中身を見ます。 *ウォッチ式を追加して、確認します。 ? objIE.Document.links(1).outertext [ 掲示板 ] ? objIE.Document.links(1).outerHTML <A href="http://www.ken3.org/cgi-bin/bbs/vba/wforum.cgi" target=_blank>[ 掲示板 ]</A> .href .outertext .outerHTMLが使えそうなので、 ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 今回使ってみます。 *さらっと書いてるけど、ここまでたどり着くのにかなりかかっている(笑) これを使えばなんとかできそうです。/* * 3.単体テストが完了、作成してみる */
単体のオブジェクト、プロパティの確認が終わったので、作成に取りかかります。
Sub ken3_url()
Dim objIE As InternetExplorer
Dim time10 As Date
Dim strURL As String
Dim i As Integer
On Error GoTo EMSG
Rows("13:1000").Select '結果の表示エリアをクリアする
Selection.Delete Shift:=xlUp
Set objIE = CreateObject("InternetExplorer.application")
objIE.GoHome
objIE.Visible = True
Do While objIE.Busy = True '起動まで待つ
DoEvents
Loop
nYLINE = 10 '10行目からチェックスタート
Cells(nYLINE, 1).Select
DoEvents
Cells(nYLINE, 2) = Now() 'テストで時間を代入
strURL = Trim(Cells(nYLINE, 1)) 'URL代入
objIE.Stop '読み込み停止(意味無いけど)
objIE.Navigate "" & strURL 'アドレスを渡し表示する
'読みこみ完了まで待つ
'20秒後を計算して、待つ
time10 = DateAdd("s", 20, Now())
Do While objIE.Busy = True
DoEvents
If time10 < Now() Then
Exit Do
End If
DoEvents
Loop
If objIE.Busy = True Then
Cells(nYLINE, 4) = "読み込みに失敗しました"
MsgBox "読み込みに失敗しました"
End If
'リンクを探す
nYLINE = 13 'セット位置を代入
'リンク数分まわす
For i = 0 To objIE.Document.links.Length - 1
Cells(nYLINE, "A") = "'" & objIE.Document.links(i).outerText
Cells(nYLINE, "B") = "'" & objIE.Document.links(i).href
Cells(nYLINE, "C") = "'" & objIE.Document.links(i).outerHTML
nYLINE = nYLINE + 1 'セット位置を+1する
Next i
objIE.Quit 'IEを閉じる
MsgBox "終了しました"
Exit Sub
EMSG:
Cells(nYLINE, 2) = "ERR"
objIE.Quit '
MsgBox "errが発生しました"
Exit Sub
End Sub |
| ※種類が豊富で探し易いです。※在庫ありが48時間以内発送が急ぎで資料や書籍がほしい時、とても助かります。 お奨め本の目次を見るだけでも勉強になったり |