ken3memoの下書き日記

試作 リンク情報の取り出し ※あとで調整する

08:05 |

Sub Link情報を取得する()
    'B3に格納されている、目的のURLを表示して、リンク情報を書き出す。

    Dim objIE     As Object  'As InternetExplorer のほうがいいけど
    Dim strURL    As String
    Dim i         As Integer
    Dim nYLINE As Integer

    'データエリアを削除する。手抜きで10行から9999行固定です。
    Rows("10:9999").Delete Shift:=xlUp

    'IEのオブジェクトを作成する
    Set objIE = CreateObject("InternetExplorer.application")
    objIE.Visible = True
    
    'ページを開く(.Navigateで表示する。)
    strURL = Trim(Range("B3")) 'セルB3の代入
    objIE.Navigate strURL      'アドレスを渡し表示する

    '読み込み完了となるまで、ループする。
    While objIE.ReadyState <> 4 Or objIE.Busy  'READYSTATE_COMPLETE = 4
        DoEvents
    Wend

    'リンクを探す※.Document.Links(i)でオブジェクトをさわる
    'リンク数分まわす A列にアンカーテキスト B列にURLを書く
    nYLINE = 10  'ここでは、10行目からセットする
    For i = 0 To objIE.Document.Links.Length - 1
        Cells(nYLINE, "A") = "'" & objIE.Document.Links(i).innerText 'テキスト
        Cells(nYLINE, "B") = objIE.Document.Links(i).href      'URL
        nYLINE = nYLINE + 1 'セット位置を＋1する
    Next i
    
    'objIE.Quit   'ＩＥを閉じる。デバック時はそのまま残した方が楽です

End Sub

あとで、調整する。

ツイートする