匿名質問者

なんとかサイトのリンクをエクセルシートに書きだそうとしています。

イミディエイトウィンドウにリンクを書き出す事は出来ましたが、この結果をエクセルシートに出力することがどうしてもできません。
どのようにしたらよいでしょうか。ご教授頂けますと幸甚です。

sub example()
Dim objIE As InternetExplorer
Set objIE = CreateObject("internetexplorer.application")
objIE.Visible = True
objIE.Navigate "hogehoge"
Do While objIE.Busy = True Or objIE.ReadyState < READYSTATE_COMPLETE
DoEvents
Loop
Dim htmlDoc As HTMLDocument
Set htmlDoc = objIE.Document
Dim el As IHTMLElement
For Each el In htmlDoc.Links
Debug.Print el.href
Next el
End Sub

回答の条件
  • 1人5回まで
  • 登録:
  • 終了:2016/02/11 16:35:03

回答1件)

匿名回答1号 No.1

Sub サイトのリンク抽出()

    Dim i%, tURL$, objIE As Object

    tURL = "http://www.yahoo.co.jp/"   'hogehogeを指定
    
    Set objIE = CreateObject("InternetExplorer.Application")    'IEを起動
        With objIE
            .Visible = True
            .Navigate tURL
        End With

    Do While objIE.ReadyState <> 4 Or objIE.Busy = True    '読み込み完了を待つ
        DoEvents
    Loop

    '新規ブックを追加してリンクを抽出する

    Workbooks.Add   '新規ブックを追加
        Range("A1") = "NO."
        Range("B1") = "リンクの表示"
        Range("C1") = "リンクURL"
        
    'LINKを書き出す
    If objIE.Document.Links.Length > 0 Then
        For i = 0 To objIE.Document.Links.Length - 1
            Cells(i + 2, "A") = i                                   'i番目
            Cells(i + 2, "B") = objIE.Document.Links(i).outerText   'リンク表示
            Cells(i + 2, "C") = objIE.Document.Links(i).href        'リンクURL
        Next i
    
    End If
    
    Columns("A:B").AutoFit '列幅を自動調整
    Range("A2").Select
    ActiveWindow.FreezePanes = True 'ウィンドウ枠の固定を設定

    objIE.Quit  'IEを閉じる
    Set objIE = Nothing 'メモリを解放
End Sub

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません