이 페이지에서

실무 위키›VBA 코드›GetRedirectURL

GetRedirectURL

Function

접속 시 리다이렉트되는 URL 주소를 반환하는 VBA 사용자 지정 함수입니다.

예제파일 다운로드

구문 = GetRedirectURL ( URL, [RequestHeader] )

인수구분 형식 설명

URL주소 필수 String

리다이렉트되는 주소를 확인할 최초 URL 주소입니다.

RequestHeader 선택 Variant

HTTP 요청에 사용할 RequestHeader 값입니다.

"Header종류", "Header값" 으로 반드시 쌍을 이루어 입력해야 합니다.

마스터 코드

복사한 코드는 VBA 편집기(Alt + F11) 새 모듈에 붙여넣어 사용하세요

Function GetRedirectURL(URL As String, ParamArray RequestHeader() As Variant) As String

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ GetRedirectURL 함수
'▶ 302 Redirect 된 URL 주소를 받아옵니다.
'▶ 인수 설명
'_____________URL                               : 데이터를 스크랩할 웹 페이지 주소입니다.
'_____________RequestHeader            : RequestHeader를 배열로 입력합니다. 반드시 짝수(한 쌍씩 이루어진) 개수로 입력되어야 합니다.
'▶ 사용 예제
'Dim sURL as String
'sURL = GetRedirectURL("https://www.google.com")
'###############################################################

Dim objHTTP As Object
Dim sUserAgent As String:
sUserAgent = "Mozilla/5.0 (Linux; Android 6.0; Nexus 5 Build/MRA58N) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.183 Mobile Safari/537.36"

Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")

objHTTP.setTimeouts 3000, 3000, 3000, 3000
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", sUserAgent
If Not IsMissing(RequestHeader) Then
    Dim vRequestHeader As Variant
    For Each vRequestHeader In RequestHeader
        Dim uHeader As Long: Dim Lheader As Long: Dim steps As Long
        uHeader = UBound(vRequestHeader): Lheader = LBound(vRequestHeader)
        If (uHeader - Lheader) Mod 2 = 0 Then GET_HttpRequest = CVErr(xlValue): Exit Function
        For i = Lheader To uHeader Step 2
            objHTTP.setRequestHeader vRequestHeader(i), vRequestHeader(i + 1)
        Next
    Next
End If
On Error GoTo NoRedirect:
objHTTP.send

GetRedirectURL = objHTTP.Option(1)
Exit Function

NoRedirect:
GetRedirectURL = URL

End Function

Module1 · GetRedirectURL

Function GetRedirectURL(URL As String, ParamArray RequestHeader() As Variant) As String

'###############################################################

'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)

'▶ GetRedirectURL 함수

'▶ 302 Redirect 된 URL 주소를 받아옵니다.

'▶ 인수 설명

'_____________URL : 데이터를 스크랩할 웹 페이지 주소입니다.

'_____________RequestHeader : RequestHeader를 배열로 입력합니다. 반드시 짝수(한 쌍씩 이루어진) 개수로 입력되어야 합니다.

'▶ 사용 예제

'Dim sURL as String

'sURL = GetRedirectURL("https://www.google.com")

'###############################################################

Dim objHTTP As Object

Dim sUserAgent As String:

sUserAgent = "Mozilla/5.0 (Linux; Android 6.0; Nexus 5 Build/MRA58N) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.183 Mobile Safari/537.36"

Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")

objHTTP.setTimeouts 3000, 3000, 3000, 3000

objHTTP.Open "GET", URL, False

objHTTP.setRequestHeader "User-Agent", sUserAgent

If Not IsMissing(RequestHeader) Then

Dim vRequestHeader As Variant

For Each vRequestHeader In RequestHeader

Dim uHeader As Long: Dim Lheader As Long: Dim steps As Long

uHeader = UBound(vRequestHeader): Lheader = LBound(vRequestHeader)

If (uHeader - Lheader) Mod 2 = 0 Then GET_HttpRequest = CVErr(xlValue): Exit Function

For i = Lheader To uHeader Step 2

objHTTP.setRequestHeader vRequestHeader(i), vRequestHeader(i + 1)

End If

On Error GoTo NoRedirect:

objHTTP.send

GetRedirectURL = objHTTP.Option(1)

Exit Function

NoRedirect:

GetRedirectURL = URL

End Function

활용 예제

리다이렉트 되는 URL 주소 받아오기 (예: 네이버 부동산)

Dim sURL as String

sURL = "https://www.naver.com/예제주소"

sURL = GetRedirectURL(sURL)

오류 방지를 위해 URL 주소가 리다이렉트 되는지 확인하기

Dim sURL as String

sURL = "https://www.naver.com/예제주소"

If sURL <> GetRedirectURL(sURL) Then MsgBox "리다이렉트 되었습니다."

안내사항

WinHttpRequest 개체를 사용하므로 윈도우 PC에서만 사용할 수 있습니다.

5 (1개 평가)

강민준🤗 2024.08.11 12:26

좋은 자료 감사합니다.🙇‍♂️

GetRedirectURL

마스터 코드

활용 예제

안내사항

바로가기

커뮤니티

문의

[공지] 오빠두에듀 프리랜서 보조 강사 모집

[직원 채용] 오빠두엑셀이 정규직 동료를 모십니다