WinHttp 한글 인코딩이 깨질 때 처리 방법(예시: 당근 사이트)

 

 

 

예를 들어 당근 사이트처럼 이미 UTF-8인코딩인 경우 WinHttp 로 HTML 문서 내용을 가져오면

인코딩이 깨집니다.

 

이런 경우 인코딩 오류를 예방하거나 처리하는 방법을 소개합니다.

 

인코딩이 깨질 때

​

첫번째 방법: WinHttp 대신 XMLHttp 혹은 ServerXMLHttp를 이용해서 접속하기

아래는 Late Binding이지만 Early Binding하려면 도구 > 참조에서 XML 6.0 등의 라이브러리를 추가합니다.

Function GetDocumentByURL(URL)
    Set winhttp = CreateObject("MSXML2.XmlHttp")
    Set document = CreateObject("Htmlfile")
    
    winhttp.Open "GET", URL, False
    winhttp.send
    document.body.innerhtml = winhttp.responseText
    Set GetDocumentByURL = document
End Function

 

 

두번째 방법: WinHttp 접속은 그대로 유지하고 responseText대신 responseBody 로 바이너리 상태 그대로 받아서 ADODB.Stream 으로 바이너리 원본을 utf-8 텍스트로 직접 인코딩하기

Function BinaryToText(BinaryData As Variant, CharSet As String) As String

    Const adTypeText = 2
    Const adTypeBinary = 1
    Dim BinaryStream
    
    Set BinaryStream = CreateObject("ADODB.Stream")
    
    '원본 데이터 타입(바이너리 원본 그대로 읽음)
    BinaryStream.Type = adTypeBinary
    BinaryStream.Open
    BinaryStream.write BinaryData
    
    ' binary -> text(텍스트 인코딩 변환)
    BinaryStream.Position = 0  '초기화
    BinaryStream.Type = adTypeText

    ' 변환할 데이터 캐릭터셋
    BinaryStream.CharSet = CharSet

    '변환한 데이터 반환
    BinaryToText = BinaryStream.ReadText

End Function

Function GetDocumentByURL(URL)
    Set winhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    Set document = CreateObject("Htmlfile")
    
    winhttp.Open "GET", URL, False
    winhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    winhttp.send
    'document.body.innerhtml = winhttp.responseText
    document.body.innerhtml = BinaryToText(winhttp.responseBody, "utf-8")
    Set GetDocumentByURL = document
End Function

 

 

세번째 방법: 리턴된 텍스트를 직접 재인코딩하기 (일부 텍스트 오류 발생)

'https://stackoverflow.com/questions/64580874/how-can-i-convert-utf-8-to-utf-16-in-excel-vba
Function ConvText(ByVal strText As String) As String

    Dim binText() As Byte, i As Long
    
    'size the binary buffer
    ReDim binText(Len(strText) - 1 + 3)
    
    'insert BOM in 0,1,2 positions
    binText(0) = &HEF
    binText(1) = &HBB
    binText(2) = &HBF
    
    'append text characters
    For i = 1 To Len(strText)
        binText(i + 2) = AscW(Mid(strText, i, 1))
    Next
    
    'write to a binary stream
    With CreateObject("ADODB.Stream")
        .Type = 1
        .Open
        .write binText
        'convert to the text stream
        .Flush
        .Position = 0
        .Type = 2
        .CharSet = "utf-8"
        'read the result skipping BOM
        .Position = 3
        ConvText = .ReadText
        .Close
    End With
    
End Function

'아래처럼 재인코딩해서 텍스트 출력
Cells(r, 1).Value = ConvText(doc.querySelectorAll("._1b153uwk").Item(i).innertext)

 

 

 

당근 사이트의 html을 파싱해서 상품이름, 가격, 동네를 출력하는 코드입니다.

 

 

Option Explicit

Sub Daangn_HTML()

    Dim http As Object, html As Object, URL As String, shtml As String, i As Integer
    
    Set http = CreateObject("MSXML2.XMLHttp")
    Set html = CreateObject("Htmlfile")
    
    'https://www.daangn.com/kr/buy-sell/?in=%EA%B0%95%EB%82%A8%EA%B5%AC-381&search=%EC%B9%B4%EC%B9%B4%EC%98%A4
    URL = "https://www.daangn.com/kr/buy-sell/?in=" & URLEncode("강남구") & "-381" & "&search=" & URLEncode([A1])
    http.Open "GET", URL, False
    http.setRequestHeader "Content-Type", "text/html"
    
    http.send
    html.body.innerHTML = http.responseText
     
    For i = 0 To 5
        Cells(5 + i, "A") = html.getElementsByClassName("_1b153uwk")(i).innertext
        Cells(5 + i, "B") = html.getElementsByClassName("_1b153uwq")(i).innertext
        Cells(5 + i, "C") = html.getElementsByClassName("_1b153uwm")(i).innertext
    Next i
    
    Set http = Nothing
    Set html = Nothing
    
End Sub

Function URLEncode$(s$, Optional bForceOldSchool As Boolean)
  Select Case True
    Case bForceOldSchool Or Val(Application.Version) < 15
               URLEncode = CreateObject("htmlfile").parentWindow.EncodeUriComponent(s)
    Case Else: URLEncode = WorksheetFunction.EncodeURL(s)
  End Select
End Function

 

 

 

 

---

 

​

그 다음 당근 사이트는 데이터를 받아올 때

JSON형태의 데이터 원본을 HTML 내부의 Script 안에 담고 있습니다.

​

이 JSON 데이터를 파싱하면 아이템이 몇개 검색되는지 알 수 있고

querySelector보다 여러가지 항목의 값을 가져오기도 간편합니다.

​

JSON 데이터는 VBAJSON 이나 JsonBag 클래스를 이용하면 VBA에서 Dictionary 데이터처럼 가져올 수 있습니다. Json("itemListElement").Count 로 몇개의 상품이 있는지 알 수 있습니다. 각 항목의 값도 가져올 수 있습니다. 예를 들어 Json("itemListElement")(1)("item")("name")로 상품 이름을, Json("itemListElement")(1)("item")("offers")("price")로 가격을 각각 가져올 수 있습니다. querySelector 보다 더 직관적입니다.

​다만 Json 데이터에는 동네 정보가 들어있지 않네요.

 

JsonBag을 이용해서 HTML내의 Json 데이터 내용을 가져오는 코드입니다.

Option Explicit

Sub Daangn_JSON()

    Dim http As Object, html As Object, URL As String, shtml As String, i As Integer
    Dim Json As New JsonBag, Jsn As New JsonBag
    Const Str1 As String = "<script type=""application/ld+json"">"
    Const Str2 As String = "</script>"
    
    Set http = CreateObject("MSXML2.XMLHttp")
    
    'https://www.daangn.com/kr/buy-sell/?in=%EA%B0%95%EB%82%A8%EA%B5%AC-381&search=%EC%B9%B4%EC%B9%B4%EC%98%A4
    URL = "https://www.daangn.com/kr/buy-sell/?in=" & URLEncode("강남구") & "-381" & "&search=" & URLEncode([A1])
    http.Open "GET", URL, False
    http.setRequestHeader "Content-Type", "text/html"
    
    http.send
    shtml = http.responseText
    
    'Json부분만 추출
    shtml = Mid(shtml, InStr(shtml, Str1) + Len(Str1))
    shtml = Left(shtml, InStr(shtml, Str2) - 1)
    
    Json.Json = shtml
    'Debug.Print Json("itemListElement").Count
    
    Range("A1:D1") = Array("상품명", "가격", "판매자", "링크")
    For Each Jsn In Json("itemListElement")
        
        Range("A" & 2 + i, "D" & 2 + i) = Array(Jsn("item")("name"), Jsn("item")("offers")("price"), _
            Jsn("item")("offers")("seller")("name"), "Link")
        
        Range("D" & 2 + i).Hyperlinks.Add Range("D" & 2 + i), Jsn("item")("url")
        i = i + 1
        If i > 10 Then Exit For
        
    Next Jsn

    Cells.Columns.AutoFit
    Set Json = Nothing: Set Jsn = Nothing
    Set http = Nothing
    
    
End Sub

Function URLEncode$(s$, Optional bForceOldSchool As Boolean)
  Select Case True
    Case bForceOldSchool Or Val(Application.Version) < 15
               URLEncode = CreateObject("htmlfile").parentWindow.EncodeUriComponent(s)
    Case Else: URLEncode = WorksheetFunction.EncodeURL(s)
  End Select
End Function

 

샘플화면:

 

 

관련: 지식인

 

당근크롤링1.xlsm

0.09MB