Excelでサイトマップ作成ソフトを作ってみよう

Step 6 次のリンク先のタイトルと次のリンクを取り出す

Topページのリンクを取り出しましたので、次のページのリンクとタイトルを調べます。
While ~ Wendループでセルが空になるまで調べます。


Homeへ > Excelでアプリケーションソフト2 > サイトマップ作成ソフト

シート画面

トップページ以下にタイトルが表示されています。
URLとタイトルが表示されている

下記のVBAコードに変更してください。

'作成開始ボタンをクリック
Private Sub CommandButton1_Click()
    Dim lcoun As Long
    Dim lCol As Long
    Dim lNowRow As Long
    
    If TextBox1 = "" Then
        MsgBox "作成するサイトアドレスを入力してください。"
        TextBox1.Activate
        Exit Sub
    End If
    
    'マウスポインターを砂時計に
    Application.Cursor = xlWait
    If ExCreateIEobject Then
        Range("A8:C65536").ClearContents
        
        lCol = 2
        lNowRow = 8
        Cells(lNowRow, lCol) = LCase(TextBox1)
        Cells(lNowRow, lCol + 1) = tIEobj.document.Title
        
        lcoun = ExGetLink(LCase(TextBox1), lNowRow, lCol)
        If lcoun > 0 Then
            lNowRow = lNowRow + 1
            While Cells(lNowRow, 2) <> "" And lNowRow < 20
                If ExNavigateIEobject(Cells(lNowRow, lCol)) Then
                    Cells(lNowRow, lCol + 1) = tIEobj.document.Title
                    lcoun = ExGetLink(Cells(lNowRow, lCol), lMaxRow, lCol)
                End If
                lNowRow = lNowRow + 1
            Wend
        
        End If
    End If
    tIEobj.Visible = True
End Sub



下記のVBAコードを追加してください。

Private Function ExNavigateIEobject(sUrl As String) As Boolean
    Dim sttime As Long
    Dim passtime As Long
    
    ExNavigateIEobject = False
On Error GoTo ErrExit
    tIEobj.navigate sUrl
    
    '読み込みが終わるまで30秒待つ
    sttime = Timer
    Do
        '経過時間を算出
        passtime = Timer - sttime
        DoEvents
        If passtime >= 30 Then
            Exit Do
        End If
        '読込み完了
        If tIEobj.ReadyState = 4 Then
            Exit Do
        End If
    Loop
    'マウスポインターを戻す
    Application.Cursor = xlNormal
    If tIEobj.ReadyState = 4 Then
        ExNavigateIEobject = True
    End If
    Exit Function
ErrExit:
    'マウスポインターを戻す
    Application.Cursor = xlNormal
On Error Resume Next
    tIEobj.Quit
    Set tIEobj = Nothing
End Function


Homeへ > Excelでアプリケーションソフト2 > サイトマップ作成ソフト

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


Copyright (c) Excel-Excel ! All rights reserved