EXCEL VBA InternetExplorerの操作（Webページ操作・監視・タイトル名取得・URL取得・ブックマーク）②

EXCEL VBA InternetExplorerの操作（Webページ操作・監視・タイトル名取得・URL取得・ブックマーク）②

Webページの表示完了待ち（エラー防止）

【IEオブジェクト.readyStateを利用した場合】①

'
'******** AKIRA55.COM ******* https://akira55.com/webpage02/
'

Sub InternetExplorer01() 'Webページの表示待ち（エラー防止）

    Dim IE As InternetExplorer

    Set IE = CreateObject("InternetExplorer.application")

    IE.Visible = True  'IEを開きます。（起動）
    
    IE.Navigate "www.akira55.com"  '指定するURLを開きます。
    
    Do While IE.ReadyState < READYSTATE_COMPLETE  '指定したページが立ち上がるまで監視します。
        DoEvents
    Loop

    MsgBox "指定したページが立ち上がりました。"
    
End Sub
'

【IEオブジェクト.Busyを利用した場合】②

'
'******** AKIRA55.COM ******* https://akira55.com/webpage02/
'
Sub InternetExplorer02() 'Webページの表示待ち（エラー防止）

    Dim IE As InternetExplorer

    Set IE = CreateObject("InternetExplorer.application")

    IE.Visible = True  'IEを開きます。（起動）
    
    IE.Navigate "www.akira55.com"  '指定するURLを開きます。
    
    Do While IE.Busy = True  '指定したページが立ち上がるまで監視します。
        DoEvents
    Loop

    MsgBox "指定したページが立ち上がりました。"
    
End Sub
'
'

【IEオブジェクト.readyStateとBusyを併用した場合】③

'
'******** AKIRA55.COM ******* https://akira55.com/webpage02/
'

Sub InternetExplorer03() 'Webページの表示待ち（エラー防止）

    Dim IE As InternetExplorer

    Set IE = CreateObject("InternetExplorer.application")

    IE.Visible = True  'IEを開きます。（起動）
    
    IE.Navigate "www.akira55.com"  '指定するURLを開きます。
    
    Do While IE.ReadyState < READYSTATE_COMPLETE Or IE.Busy = True   '指定したページが立ち上がるまで監視します。
        DoEvents
    Loop

    MsgBox "指定したページが立ち上がりました。"
    
End Sub
'

InternetExplorerの各タイトル名を取得します。メッセージボックスに一覧表示

'
'******** AKIRA55.COM ******* https://akira55.com/webpage02/
'
Sub InternetExplorer05()  'IEの各タイトル名を取得します。

    Dim Exp_Shell, Win_Shell, IE_temp As Object
    Dim IE_Title, ALL_Title As String
    Dim I As Long
    
    Set Exp_Shell = CreateObject("shell.application") '現在開いているIEページをExp_Shellへ収納します。
    
    ALL_Title = ""  '集計するタイトル名をクリアーします。
    I = 1  '
    
    For Each Win_Shell In Exp_Shell.Windows  '開いているIEページを全て繰り返します。

        IE_Title = ""  '取得するIEタイトルをクリアーします。
        On Error Resume Next  'タイトル名が取得できない場合のエラーを回避します。
        IE_Title = Win_Shell.Document.Title  '取得したタイトル名をIE_Titleへ代入します。
        On Error GoTo 0
        
        If IE_Title <> "" Then  'タイトル名を取得できたか確認します。
            ALL_Title = ALL_Title + vbCrLf & I & "----" & IE_Title & vbCrLf
              'タイトル名が取得できた場合は、ALL_Titleに
            I = I + 1 'タイトルの件数を加算（NO）します。
        End If
        
    Next Win_Shell
    
    If ALL_Title <> "" Then
            MsgBox "【　IEの取得したタイトル名は以下の通りです。】" & vbCrLf & ALL_Title
        Else
            MsgBox "IEのタイトル名を取得できませんでした。"
    End If
    

End Sub
'

IEのタイトル名を取得して、EXCELシートにタイトル名とURL転記します。

'
'******** AKIRA55.COM ******* https://akira55.com/webpage02/
'
Sub InternetExplorer06()  'IEのタイトル名を取得して、シートに転記します。

    Dim Exp_Shell, Win_Shell, IE_temp As Object
    Dim Ws01 As Worksheet
    Dim IE_Title, IE_Url As String
    Dim I As Long

    Set Ws01 = Worksheets("Web一覧")  '取得したタイトル名を転記するシート名を指定します。
    
    
    Set Exp_Shell = CreateObject("shell.application") '現在開いているIEページをExp_Shellへ収納します。
    I = 2
    
    For Each Win_Shell In Exp_Shell.Windows '開いているIEページを全て繰り返します。

        IE_Title = "" '取得するIEタイトルをクリアーします。
        On Error Resume Next 'タイトル名が取得できない場合のエラーを回避します。
        IE_Title = Win_Shell.Document.Title '取得したタイトル名をIE_Titleへ代入します。
        IE_Url = Win_Shell.LocationURL '取得したURLをIE_URLへ代入します。
        On Error GoTo 0

        If IE_Title <> "" Then  'IEのタイトル名を取得したら「Web一覧」シートに転記します。
            With Ws01
                Cells(I, "A") = I - 1  '「Web一覧」シートのA列に【No】を代入します。
                Cells(I, "B") = IE_Title  '「Web一覧」シートのB列に【タイトル名】を代入します。
                .Hyperlinks.Add anchor:=Range("C" & I), Address:=IE_Url '「Web一覧」シートのC列に【URL】を代入します。
            End With
            I = I + 1  'No(ナンバー)を＋１加算します。

        End If

    Next Win_Shell

End Sub
'