Option Explicit

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

Const WAIT_TIME As Long = 5000

'LPの取得
Sub Get_Redirect_LP_URL_Click()

    '宣言
    Dim objIE As Object
    Dim url As String
    Dim urlLocation As String
    Dim rowUrl As String
    
    '初期設定
    Set objIE = CreateObject(""InternetExplorer.Application"")
    objIE.Visible = True
    rowUrl = 3
    
    Do While Cells(rowUrl, 2) <> """"
        url = Cells(rowUrl, 2)
        objIE.Navigate url
        Sleep WAIT_TIME
        urlLocation = objIE.LocationURL
        Cells(rowUrl, 3) = urlLocation
        rowUrl = rowUrl + 1
    Loop

End Sub