VBA에서 Web 정보 가져오기 (Web Scraping)

Web Page에서 원하는 정보를 가져와서 재구성하거나 필요한 파일을 Web에서 다운로드 할 때,

또는 RESTful API를 이용하여 정보를 획득할 때 등등 Web에서 필요한 정보를 가져오기 하는 함수입니다.

 

Web 스크래핑에 사용할 수 있는 개체는 대략 3가지 정도입니다.

MSXML2.XMLHTTP.6.0,  MSXML2.ServerXMLHTTP,  WinHttp.WinHttpRequest.5.1

각각 속도와 장단점이 있기 때문에 일반적으로 XMLHTTP6.0을 사용하고 나머지 2개는 필요한 경우에 별도로 지정을 하도록 합니다.

    On Error Resume Next
    Select Case UseObject
    Case 1        ''// 일반적인 환경에서 속도가 빠름, OAuth처럼 Redirect가 필요한 경우에 이것을 써야 함.
        Set oHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
                  ''// 사용 버전이 맞지 않을 때 다운그레이드 적용
        If Err.Number <> 0 Then Set oHTTP = CreateObject("MSXML2.XMLHTTP")
    Case 2        ''// Local PC에 cache 되지 않아야 할 때
        Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Case 3        ''// Local PC에 cache 되지 않아야 할 때, SetTimeouts를 설정할 수 있음.
        Set oHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    End Select
    oHTTP.SetTimeouts 5000, 5000, 5000, 5000      ''//WinHttpRequest.5.1 에서만 유효함
    On Error GoTo 0

 

각각의 Web Page에 따라 Header 설정이 필요한 경우에는

Header Key와 Value 쌍을 Chr(7)을 이용하세 연결하여 넘겨줍니다.

Header = Header_Key1 & Chr(7) & Header_Value1 & Chr(7) & Header_Key2 & Chr(7) & Header_Value2

사용할 때는 Chr(7)을 기준으로 분할하여 사용합니다.

        If Header <> "" Then
            vHeader = Split(Header, Chr(7))
            For i = LBound(vHeader) To UBound(vHeader) Step 2
                .setRequestHeader vHeader(i), vHeader(i + 1)
            Next
        End If

 

Request Method가 "POST", "PUT", "PATCH" 등에서는 필요한 정보를 Body로 넘겨줍니다.

Body에 대한 구성은 지정한 포멧으로 해야 문제가 없으므로 해당 site의 설명 내용을 꼭 확인합니다.

If Body = "" Then .send Else .send Body

 

정보를 가져올 때 용도에 따라 가져와야 할 대상이 다르므로 이에 대한 지정도 할 수 있도록 합니다.

        If RtnItem = 1 Then getURL = .responseText   ''// String
        If RtnItem = 2 Then getURL = .responseBody   ''// Variant/Byte() Binary File 가능
        If RtnItem = 3 Then getURL = .Status         ''// Long
        If RtnItem = 4 Then getURL = .statusText     ''// String
        If RtnItem = 5 Then getURL = .responseXML    ''// Object/DomDocument 개체이므로 주의

 

작업중 에러가 발생한 경우에 처리를 해 줍니다.

ERROR_RUN:
    Select Case Err.Number
    Case -2147012894                  ''// Timeout
        getURL = "ERROR: Timeout"
    Case -2147012891                  ''// Invalid URL
        getURL = "ERROR: Invalid URL"
    Case Else                         ''// Other
        getURL = "ERROR: " & Error(Err.Number) & vbNewLine & Err.description
    End Select

 

실제 함수는 아래와 같이 정리됩니다.

Function getURL(URL As String, Optional RequestMethod As String = "GET", Optional Sync As Boolean = False, _
Optional Header As String = "", Optional Body As String = "", Optional UseObject As Integer = 1, Optional RtnItem As Integer = 1)
    ''// RequestMethod는 "GET", "POST", "PUT", "PATCH", "DELETE" 등
    ''// Body는 "POST"나 "PUT", "PATCH" 등에서 사용할 Entity
    ''// Header는 setRequestHeader에 넣어야 할 옵션 쌍으로 Chr(7)로 연결하고 Split으로 잘라서 사용할 것
    ''// UseObject는 사용할 HTTP 개체를 아래를 참고하여 지정
    ''// RtnItem Return할 내용 1=responseText, 2=responseBody, 3=status, 4=statusText, 5=responseXML
    Dim oHTTP As Object, vHeader As Variant
    Dim iMaxRetry As Long, iRetry As Long, i As Long
    
    On Error Resume Next
    Select Case UseObject
    Case 1        ''// 일반적인 환경에서 속도가 빠름, OAuth처럼 Redirect가 필요한 경우에 이것을 써야 함.
        Set oHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
                  ''// 사용 버전이 맞지 않을 때 다운그레이드 적용
        If Err.Number <> 0 Then Set oHTTP = CreateObject("MSXML2.XMLHTTP")
    Case 2        ''// Local PC에 cache 되지 않아야 할 때
        Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Case 3        ''// Local PC에 cache 되지 않아야 할 때, SetTimeouts를 설정할 수 있음.
        Set oHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    End Select
    oHTTP.SetTimeouts 5000, 5000, 5000, 5000      ''//WinHttpRequest.5.1 에서만 유효함
    On Error GoTo 0
    
    On Error GoTo ERROR_RUN
    With oHTTP
        .Open RequestMethod, URL, Sync
        
        If Header <> "" Then
            vHeader = Split(Header, Chr(7))
            For i = LBound(vHeader) To UBound(vHeader) Step 2
                .setRequestHeader vHeader(i), vHeader(i + 1)
            Next
        End If

        If Body = "" Then .send Else .send Body

        If RtnItem = 1 Then getURL = .responseText   ''// String
        If RtnItem = 2 Then getURL = .responseBody   ''// Variant/Byte()
        If RtnItem = 3 Then getURL = .Status         ''// Long
        If RtnItem = 4 Then getURL = .statusText     ''// String
        If RtnItem = 5 Then getURL = .responseXML    ''// Object/DomDocument 개체이므로 주의
        
    End With
    
EXIT_RUN:
    Set oHTTP = Nothing
    Exit Function
    
ERROR_RUN:
    Select Case Err.Number
    Case -2147012894                  ''// Timeout
        getURL = "ERROR: Timeout"
    Case -2147012891                  ''// Invalid URL
        getURL = "ERROR: Invalid URL"
    Case Else                         ''// Other
        getURL = "ERROR: " & Error(Err.Number) & vbNewLine & Err.description
    End Select
    GoTo EXIT_RUN
End Function

 

이 함수를 이용하여 Google API를 이용한 번역, Naver Papago API를 이용한 번역 등에 사용하고,

EGTools의 새 버전을 자동 업데이트할 때에는 responseBody를 이용해서 다운로드 합니다.