이 페이지에서

실무 위키›VBA 코드›GetHttp

GetHttp

Function

특정 URL 의 웹페이지 정보를 HTML 문서로 받아오는 VBA 크롤링 사용자 지정 함수입니다.

예제파일 다운로드

구문 = GetHttp ( URL, [FormText], [IsWinHttp], [RequestHeader], [IncludeMeta], [RequestType] )

인수구분 형식 설명

URL 필수 String

웹페이지 정보를 받아올 URL 주소입니다.

FormText 선택 String

직접적인 쿼리 문자열이 아닌 FormText 데이터로 쿼리를 전달해야 할 경우에 쿼리문을 입력합니다.

Content-Type 이 application/x-www-form-urlencoded 인 경우가 여기에 해당합니다.

IsWinHttp 선택 Boolean

WinHTTP 로 요청할지 여부입니다. 기본값은 False 로, XMLHttp 요청을 보냅니다.

상황에 따라 페이지 Redirect 가 필요할 경우 TRUE 로 입력하여 WinHTTP 요청을 보냅니다.

RequestHeader 선택 Variant

URL 주소와 함께 전송할 RequestHeader 를 배열로 입력합니다.

반드시 짝수(Header 와 Value 가 한 쌍)로 입력해야 하며, 개수가 짝수가 아닐 경우 #VALUE! 오류를 반환합니다.

IncludeMeta 선택 Boolean

424 런타임 "개체가 필요합니다." 오류가 발생할 경우 True 로 사용합니다. 기본값은 False 입니다.

True 로 사용하면 HTML 문서의 InnerText 속성은 사용할 수 없습니다.

RequestType 선택 String

HTTP 요청 방식을 선택합니다. 기본값은 "GET" 입니다.

마스터 코드

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

Function GetHttp(URL As String, Optional formText As String, _
Optional isWinHttp As Boolean = False, _
Optional RequestHeader As Variant, _
Optional includeMeta As Boolean = False, _
Optional RequestType As String = "GET") As Object

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ GetHttp 함수
'▶ 웹에서 데이터를 받아옵니다.
'▶ 인수 설명
'_____________URL : 데이터를 스크랩할 웹 페이지 주소입니다.
'_____________formText : Encoding 된 FormText 형식으로 보내야 할 경우, Send String에 쿼리문을 추가합니다.
'_____________isWinHttp : WinHTTP 로 요청할지 여부입니다. Redirect가 필요할 경우 True로 입력하여 WinHttp 요청을 전송합니다.
'_____________RequestHeader : RequestHeader를 배열로 입력합니다. 반드시 짝수(한 쌍씩 이루어진) 개수로 입력되어야 합니다.
'_____________includeMeta : TRUE 일 경우 HTML 문서위로 ResponseText를 강제 입력합니다. Meta값이 포함되어 HTML이 작성되며 innerText를 사용할 수 없습니다. 기본값은 False 입니다.
'_____________RequestType : 요청방식입니다. 기본값은 "GET"입니다.
'▶ 사용 예제
'Dim HtmlResult As Object
'Set htmlResult = GetHttp("https://www.naver.com")
'msgbox htmlResult.body.innerHTML
'###############################################################

Dim oHTMLDoc As Object: Dim objHTTP As Object
Dim HTMLDoc As Object
Dim i As Long: Dim blnAgent As Boolean: blnAgent = False
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"

Application.DisplayAlerts = False

If Left(URL, 4) <> "http" Then URL = "http://" & URL

Set oHTMLDoc = CreateObject("HtmlFile")
Set HTMLDoc = CreateObject("HtmlFile")

' 2023-02-22 | 수정 | 윈도우 인증 접속 문제 발생 시 (일부 버전) ServerXMLHTTP -> XMLHTTP 요청으로 변경
' XMLHTTP 요청 시, TimeOut 세팅 불가 (기본값 설정)
' https://stackoverflow.com/questions/11605613/differences-between-xmlhttp-and-serverxmlhttp
On Error GoTo SendError:
'------------------------------
If isWinHttp = False Then
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
Else
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
End If

objHTTP.setTimeouts 1200000, 1200000, 1200000, 1200000 '응답 대기시간 120초

' 2023-02-22 | 수정 | 윈도우 인증 접속 문제 발생 시 (일부 버전) ServerXMLHTTP -> XMLHTTP 요청으로 변경
SendRestart:
'------------------------------
objHTTP.Open RequestType, URL, False
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 GetHttp = CVErr(xlValue): Exit Function
For i = Lheader To uHeader Step 2
If vRequestHeader(i) = "User-Agent" Then blnAgent = True
objHTTP.setRequestHeader vRequestHeader(i), vRequestHeader(i + 1)
Next
Next
End If
If blnAgent = False Then objHTTP.setRequestHeader "User-Agent", sUserAgent

objHTTP.send formText

If includeMeta = False Then
With oHTMLDoc
.Open
.Write objHTTP.responseText
.Close
End With
Else
oHTMLDoc.Body.innerHTML = objHTTP.responseText
End If

Set GetHttp = oHTMLDoc
Set oHTMLDoc = Nothing
Set objHTTP = Nothing

Application.DisplayAlerts = True

' 2023-02-22 | 수정 | 윈도우 인증 접속 문제 발생 시 (일부 버전) ServerXMLHTTP -> XMLHTTP 요청으로 변경
Exit Function

SendError:
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
On Error GoTo 0
Resume SendRestart:
'------------------------------

End Function

Module1 · GetHttp

Function GetHttp(URL As String, Optional formText As String, _

Optional isWinHttp As Boolean = False, _

Optional RequestHeader As Variant, _

Optional includeMeta As Boolean = False, _

Optional RequestType As String = "GET") As Object

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

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

'▶ GetHttp 함수

'▶ 웹에서 데이터를 받아옵니다.

'▶ 인수 설명

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

'_____________formText : Encoding 된 FormText 형식으로 보내야 할 경우, Send String에 쿼리문을 추가합니다.

'_____________isWinHttp : WinHTTP 로 요청할지 여부입니다. Redirect가 필요할 경우 True로 입력하여 WinHttp 요청을 전송합니다.

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

'_____________includeMeta : TRUE 일 경우 HTML 문서위로 ResponseText를 강제 입력합니다. Meta값이 포함되어 HTML이 작성되며 innerText를 사용할 수 없습니다. 기본값은 False 입니다.

'_____________RequestType : 요청방식입니다. 기본값은 "GET"입니다.

'▶ 사용 예제

'Dim HtmlResult As Object

'Set htmlResult = GetHttp("https://www.naver.com")

'msgbox htmlResult.body.innerHTML

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

Dim oHTMLDoc As Object: Dim objHTTP As Object

Dim HTMLDoc As Object

Dim i As Long: Dim blnAgent As Boolean: blnAgent = False

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"

Application.DisplayAlerts = False

If Left(URL, 4) <> "http" Then URL = "http://" & URL

Set oHTMLDoc = CreateObject("HtmlFile")

Set HTMLDoc = CreateObject("HtmlFile")

' 2023-02-22 | 수정 | 윈도우 인증 접속 문제 발생 시 (일부 버전) ServerXMLHTTP -> XMLHTTP 요청으로 변경

' XMLHTTP 요청 시, TimeOut 세팅 불가 (기본값 설정)

' https://stackoverflow.com/questions/11605613/differences-between-xmlhttp-and-serverxmlhttp

On Error GoTo SendError:

'------------------------------

If isWinHttp = False Then

Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")

Else

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

End If

objHTTP.setTimeouts 1200000, 1200000, 1200000, 1200000 '응답 대기시간 120초

' 2023-02-22 | 수정 | 윈도우 인증 접속 문제 발생 시 (일부 버전) ServerXMLHTTP -> XMLHTTP 요청으로 변경

SendRestart:

'------------------------------

objHTTP.Open RequestType, URL, False

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 GetHttp = CVErr(xlValue): Exit Function

For i = Lheader To uHeader Step 2

If vRequestHeader(i) = "User-Agent" Then blnAgent = True

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

End If

If blnAgent = False Then objHTTP.setRequestHeader "User-Agent", sUserAgent

objHTTP.send formText

If includeMeta = False Then

With oHTMLDoc

.Open

.Write objHTTP.responseText

.Close

End With

Else

oHTMLDoc.Body.innerHTML = objHTTP.responseText

End If

Set GetHttp = oHTMLDoc

Set oHTMLDoc = Nothing

Set objHTTP = Nothing

Application.DisplayAlerts = True

' 2023-02-22 | 수정 | 윈도우 인증 접속 문제 발생 시 (일부 버전) ServerXMLHTTP -> XMLHTTP 요청으로 변경

Exit Function

SendError:

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

On Error GoTo 0

Resume SendRestart:

'------------------------------

End Function

활용 예제

네이버 메인 페이지의 HTML 문을 시트에 출력하기

Sub 네이버크롤링예제()

Dim htmlResult As HTMLDocument

Dim htmlString As String

Set htmlResult = GetHttp("https://www.naver.com")

htmlString = htmlResult.body.innerhtml

Sheet1.Range("A10").Value = htmlString

End Sub

네이버 메인 페이지의 내비게이션 메뉴 가져오기

'// [도구] - [참조] 에서 Microsoft HTML Object Library 를 추가합니다.

Sub 네이버크롤링예제()

Dim htmlResult As HTMLDocument

Dim htmlItem As IHTMLElement

Dim i As Long

Set htmlResult = GetHttp("https://www.naver.com")

i = 1

For Each htmlItem In htmlResult.getElementsByClassName("nav_item")

Sheet1.Cells(i, 1).Value = htmlItem.innerText

i = i + 1

End Sub

안내사항

결과값으로 HTML 문서를 반환하므로 시트 위에서는 사용할 수 없습니다.

결과를 HTMLDocument 형식으로 받으려면 VBA 편집기의 [도구] → [참조] 에서 Microsoft HTML Object Library 를 추가해야 합니다.

424 런타임 "개체가 필요합니다." 오류가 발생하면 IncludeMeta 를 True 로 사용합니다.

4.9 (12개 평가)

크롱* 2021.01.09 21:32

안녕하세요. 강의 잘 보고 있습니다.
Post 방식으로 사용하기 위해 Get을 Post로 바꾸고 Data를 추가, 헤더 정보를 넣었는데 uHeader = UBound(vRequestHeader): Lheader = LBound(vRequestHeader) 부분에서 에러가 납니다.
코드를 잘못 건드렸나 다시 원래대로 Get으로 사용해도 헤더에서 에러가 납니다. 쌍으로 넣었는데 무슨 문제일까요??

Sub test()
  Dim htmlResult As Object
  Dim strResult As String
  Dim url As String
  Dim data As String
  url = "https://www.naver.com"
  data = "test"

  Set htmlResult = PostHttp(url, data, "gzip", "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8")
  strResult = htmlResult.body.innerHtml
Msgbox strResult
End Sub

Function PostHttp(url As String, data As String, ParamArray RequestHeader() As Variant) As Object
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ PostHttp 함수
'▶ 웹에서 데이터를 받아옵니다.
'▶ 인수 설명
'_____________URL                : 데이터를 스크랩할 웹 페이지 주소입니다.
'_____________RequestHeader      : RequestHeader를 배열로 입력합니다. 반드시 짝수(한 쌍씩 이루어진) 개수로 입력되어야 합니다.
'▶ 사용 예제
'Dim HtmlResult As Object
'Set htmlResult = GetHttp("https://www.naver.com")
'msgbox htmlResult.body.innerHTML
'###############################################################

Dim oHTMLDoc As Object: 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"

Application.DisplayAlerts = False

Set oHTMLDoc = CreateObject("HtmlFile")
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")

objHTTP.setTimeouts 3000, 3000, 3000, 3000
objHTTP.Open "POST", 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
objHTTP.send data

With oHTMLDoc
  .Open
  .Write objHTTP.responsetext
  .Close
End With

Set PostHttp = oHTMLDoc
Set oHTMLDoc = Nothing
Set objHTTP = Nothing

Application.DisplayAlerts = True

End Function

오빠두엑셀 작성자 2021.01.12 23:11

안녕하세요.
대부분의 웹페이지는 HTTP요청으로 POST 하는 것을 허용하지 않습니다.
따라서 네이버에서 해당 기능을 지원하는지 우선 확인이 필요합니다.
https://www.postman.com/ 에서 POST 명령이 올바르게 동작하는지 우선 확인해보시면 좋을 듯 합니다.
만약 POST가 허용되지 않을 경우, 셀레니움을 활용하거나 네이버에서 제공하는 API가 있는지 확인 후 적용하는 방향으로 해결해보세요.
제시해드린 답변이 문제해결에 도움이 되셨길 바랍니다. 감사합니다.

일리안25 2021.01.28 10:11

예제파일을 다운로드 했는데 매크로를 실행할 수 없습니다. 이 통합 문서에서 사용할 수 없는 매크로이거나 모든 매크로를 사용하지 못할 수 있습니다. 라고 나옵니다.

일리안25 2021.01.28 10:13

Sub 크롤링예제2()

 

Dim htmlResult As HTMLDocument

Dim htmlItem As IHTMLElement

Dim htmlString As String

 

Set htmlResult = GetHttp(Sheet1.Range("B8").Value)

htmlString = htmlResult.body.innerhtml

 

For Each htmlItem In htmlResult.getElementsByClassName("Class")

    htmlItem.innerText

Next

 

End Sub

예제에서 htmlString에 htmlResult에서 추출해서 문자열을 저장한뒤에 그뒤에 htmlString에 대해 더이상의 조작이 없는데 이건 왜 필요한건가요?

김두식 2021.03.11 21:47

안녕하세요. 오랜만에 문의 드립니다.
웹페이지 본문 내용은 크롤링이 안되는것 같습니다. (메뉴부분만 responseText 됨니다.)
현재 테스트 중 페이지 입니다.
https://www.costco.co.kr/Kirkland-Signature/c/ks_all
상품리스트 중 ID와 상품명을 엑셀로 옮기려 합니다.
전체소스 (html문서)를 가겨오지못하니 ID추출이 안됩니다.
예제의 네이버도 그런것 같고요. 방법이 있을까요?
본문 별도 URL이 있는걸까요?

오빠두엑셀 작성자 2021.03.12 03:33

안녕하세요.
페이지에 따라 일부 HTML 구문은 자바스크립트를 통해 반환되기도 합니다.
아래 강의에 소개해드린 방법을 활용해서,
네트워크 분석을 통해서 홈페이지 구조를 분석한 뒤, 원하시는 내용을 출력하는 소스를 직접 확인해보세요.
https://www.oppadu.com/%EC%97%91%EC%85%80-%ED%81%AC%EB%A1%A4%EB%A7%81-%EB%84%A4%EC%9D%B4%EB%B2%84-%EB%B6%80%EB%8F%99%EC%82%B0/

와와 2021.04.03 20:36

강의를 너무쉽게 잘해주셔서 잘 보고 있습니다.
gethttp함수를 이용하면 불러오지 못하는 사이트들이 있는데 왜 그런걸까요?
예를 들면 https://m.stock.naver.com/sise/siseList.nhn 의 경우 웹페이지 내용을 하나도 불러오지 못합니다.
Dim htmlResult As HTMLDocument, url As String
url = "https://m.stock.naver.com/sise/siseList.nhn"
Set htmlResult = GetHttp(url)
Debug.Print htmlResult.body.innerHTML
해보면 아무 내용이 없습니다.
"https://m.naver.com" 해보면 내용을 잘 불러오구요.
특정페이지는 안되는 이유가 따로 있는건가요?

오빠두엑셀 작성자 2021.04.07 12:28

일부 페이지는 웹페이지 자료를 해당 경로에서 받아오지 않고 자바스크립트나 또 다른 네트워크 패킷을 통해 자료를 받아옵니다.
네트워크 분석으로 페이지 정보를 어느 경로에서 받아오는지 한번 확인해보세요.
아래 강의도 같이 참고하면 많은 도움이 되실겁니다.
https://www.oppadu.com/%EC%97%91%EC%85%80-%ED%81%AC%EB%A1%A4%EB%A7%81-%EB%84%A4%EC%9D%B4%EB%B2%84-%EB%B6%80%EB%8F%99%EC%82%B0/

Jimmy 2021.08.04 18:05

euc-kr로 인코딩된 웹페이지를 크롤링하는 방법을 좀 알려 주세요. 미리 감사드립니다.

찌오스 2022.04.27 00:11

IE로는 정상적으로 innertext 값을 가져오나. Debug.print 하면 XMLhttp나 GetHttp로는 값이 없는걸로 나옵니다.
Javascript에서 의 id를 이용해서 값을 수정하고 있습니다.

양동이 2022.07.09 22:07

정말 좋은 내용에 감사드립니다.
이 함수에 대해 한가지 문의드릴 것이 있는데요,
이 함수를 이용해 네이버 카페에서 게시물 리스트를 크롤링하려 했으나
'-1072896658(c00ce56e)'런타임 오류가 발생, 시스템이 지정한 인토딩을 지원하지 않는다고 하면서 아래 구문이 노랗게 되고 멈춥니다.
.Write objHTTP.ResponseText

몇년 전에 네이버카페는 유니코드로 변환해야 한다는 말을 어디서 들은 것도 같아서 그렇게 하면 해결될지도 모른다 싶었는데, 변환하는 방법도 잘 모르겠어서 도움을 요청드립니다.

오빠두엑셀 작성자 2022.07.11 16:23

안녕하세요?^^
인코딩이 어떤 형식으로 되어있는지 모르겠으나,
보통 문제가 발생하는 EUC-KR 일 경우 ADODB 라이브러리를 사용하면 해결할 수 있습니다.
구글에 검색하면 관련내용이 많이 있으니 한번 확인해보시면 좋을 것 같습니다.
감사합니다.

양동이 2022.07.13 13:13

정말 감사합니다!
카페에서 F12로 볼 때 코드 중에 charset="EUC-KR"이라는 게 몇 개 검색되네요. 시도해 보겠습니다~

동동쌤 2024.02.07 20:16

구글번역기를 만드는 영상에서는 gethttp문을 사용할때 .body.innerhtml 이라는 부분이 없었는데 구글연관검색어 조회를 하는 프로그램을 만드실 때는 gethttp문을 사용할 때 .body.innerhtml가 기본설정값처럼 사용하라고 하셔서 언제 .body.innerhtml를 사용하고 안하는지에 대한 부분이 이해가 잘되지 않아서 질문 남깁니다. 있고 없고의 차이를 간략하게 알 수 있을까요?