VBA メモ

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub ExtractBlueTextFromEdge()

    Dim objEdge As Object

    Dim objShell As Object

    Dim objTab As Object

    Dim objLink As Object

    Dim sWord As String

    Dim BlueText As String

    Dim i As Long

    'Edge起動

    Set objShell = CreateObject("Shell.Application")

    Set objEdge = objShell.Windows.Item(0)

    objEdge.Navigate "https://kbn48.com/excel/628"

    Do While objEdge.ReadyState <> 4: DoEvents: Loop

    Sleep (3000) ' ページが完全に読み込まれるまで待つ

    '青いリンクのテキストを取得

    Set objTab = objEdge.Document.getElementById("content")

    i = 1

    For Each objLink In objTab.getElementsByTagName("a")

        If objLink.Style.color = "blue" Then

            Cells(i, 1).Value = objLink.innerText

            i = i + 1

        End If

    Next objLink

End Sub