ExcelでGoogleサイトマップ用xmlファイル作成ソフトを作ってみよう

Step 5 取り出したURLから、さらに次のリンクを取り出す

Srep3でテキストボックスに入力されたURLからリンク一覧を作成しました。
そのリンク一覧の上から順に次のリンク先を取り出します。

Homeへ > アプリケーションソフト > xmlファイル作成ソフト > Step5 URLから、さらに次のリンクを取り出す

スポンサーリンク






設定画面

取り出したリンクから、さらに次のリンクを調べていきます。
リンク調査シート

実行コード

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

'作成開始ボタンをクリック
Private Sub CommandButton1_Click()
    Dim lcoun As Long
    Dim lrow As Long
    Dim lcol As Long
    
    If TextBox1 = "" Then
        MsgBox "作成するサイトアドレスを入力してください。"
        TextBox1.Activate
        Exit Sub
    End If
    
    'マウスポインターを砂時計に
    Application.Cursor = xlWait
    'IEをオープン
    If ExIeOpen Then
        Range("A10:C65536").ClearContents
        lrow = 10
        lcol = 2
        lcoun = ExMakeLinkList(LCase(TextBox1), lrow, lcol)
        If lcoun > 0 Then
            lrow = lrow + 1
            While Cells(lrow, lcol) <> ""
                If ExIeNavigate(Cells(lrow, lcol)) Then
                    lcoun = ExMakeLinkList(Cells(lrow, lcol), lMaxRow, lcol)
                End If
                lrow = lrow + 1
            Wend
        
        End If
    End If
    
    'IEを閉じる
    tIEobj.Quit
    Set tIEobj = Nothing
    Application.Cursor = xlNormal
End Sub

スポンサーリンク



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

Private Function ExIeNavigate(surl As String) As Boolean
    Dim sttime As Long
    Dim passtime As Long
    
    ExIeNavigate = False
On Error GoTo ErrExit
    tIEobj.navigate surl
    
    '開始時間を保存
    sttime = Timer
    Do
        '経過時間を計算
        passtime = Timer - sttime
        DoEvents
        If passtime >= 30 Then
            Exit Do
        End If
        'URLが開いたらループを抜ける
        If tIEobj.ReadyState = 4 Then
            Exit Do
        End If
    Loop
    Application.Cursor = xlNormal
    If tIEobj.ReadyState = 4 Then
        ExIeNavigate = True
    End If
    Exit Function
ErrExit:
    Application.Cursor = xlNormal
On Error Resume Next
    tIEobj.Quit
    Set tIEobj = Nothing
End Function

スポンサーリンク






Homeへ > アプリケーションソフト > xmlファイル作成ソフト > Step5 URLから、さらに次のリンクを取り出す

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


Copyright (c) Excel-Excel ! All rights reserved