[파싱]블러드앤소울 웹사이트 캐릭터별 능력치, 장비내역 파싱해서 가져오기

위 게임 사이트의 각 캐릭터의 능력치, 장비 등의 자료를 엑셀로 가져오는 예시입니다.

아래 그림의 파란색 네모 부분을 가져오는 것입니다.

엑셀화면은 아래와 같습니다.

웹사이트 자료 가져오는 연습 삼아 만들어 보았습니다.

위 사이트는 간단한 프로필 즉, 레벨이나 등급 등은 일반 html로 받아오고

공격, 방어율, 자세한 장비 보유 유무 등은 JSON 형태로 실시간으로 받아와서 html로 뿌려주고 있네요.

일반html은 winhttp, xmlhttp 를 이용해서 html을 받아오면 되고

JSon 데이터는 간단한 문자열 구조인데 문자열을 나눌(파싱할) 때 VBA-JSON이라는 라이브러리를 이용하여 파싱할 수 있습니다.

캐릭터이름을 새로 추가 입력하고 나서 우측 상단 새로고침 아이콘을 누르면 

테스트 목적으로만 사용할 것인지 확인하고 나면 세번의 접속을 시도합니다.

1.일반 프로필(HTML방식)

http://bns.plaync.com/bs/character/profile/홍길동

2.능력치(JSON방식)

https://api-bns.plaync.com/bnsapi/character/abilities/홍길동

3.장비(JSON방식)

https://api-bns.plaync.com/bnsapi/character/equipments/홍길동

HTML방식은 HTML Object Library 를 이용해서

class이름으로 데이터를 가져옵니다.

HTML객체.getElementsByClassName("info") 이런식입니다.

Json 데이터는 VBAJSON을 이용해서

Json("records")("total_ability")("max_hp")나  Json("records")(1)("item")("name") 이런식으로 문자열 데이터를 가져옵니다.

아래는 주요 매크로 내용입니다.

'Macro to Fetch 'Blood&Soul' Game Character Profile
'by konahn(at)naver.com
'At [Tools-Reference], 'Microsoft Html Object Library' and 'Microsoft Scripting Engine' should be checked.
'Powered by VBA-JASON (c) Tim Hall - https://github.com/VBA-tools/VBA-JSON
 
Option Explicit
Option Compare Text
 
Sub getProfile()
 
    Dim XMLhttp As Object   'MSXML2.ServerXMLHTTP
    Dim Html As MSHTML.HTMLDocument
    Dim elems As MSHTML.IHTMLElementCollection
    Dim lastRow As Long
    Dim r As Range
    Dim Info() As String, Equip() As String
    Dim JsonStr As String
    Dim Json As Object, J As Object
    Dim usr As VbMsgBoxResult
    
    usr = MsgBox("과도한 검색은 사이트에 무리를 줄 수 있습니다." & vbNewLine & vbNewLine & _
        "테스트목적으로만 사용하시겠습니까?", vbOKCancel, "Getting BnS Profile")
    If usr <> vbOK Then Exit Sub
    
    Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
    'Set XMLhttp = New MSXML2.ServerXMLHTTP
    Set Html = New MSHTML.HTMLDocument
    If XMLhttp Is Nothing Or Html Is Nothing Then GoTo DONE
    
    Application.ScreenUpdating = False
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Range("B5:Z" & lastRow).ClearContents
    
    On Error Resume Next
    For Each r In Range("A5:A" & lastRow)
        
        '// 기본 정보
        With XMLhttp
            .Open "Get", Range("B1").Value & ENCODEURL(r.Value), False
            .setRequestHeader "User-Agent", "Mozilla"
            .send
            .waitForResponse
            Html.body.innerHTML = .responseText
        End With
        
        '암살자| 경국지색| 레벨 50(&bull;) 홍문2성| 혼천교입교인| 활빈당
        Set elems = Html.getElementsByClassName("info")
        If elems.Length = 0 Then MsgBox "Character:" & r.Value & " not found"   ': Exit For
        Info = Split(elems(0).innerText, "| ")
        
        
        r.Offset(, 1) = Split(Info(2), ChrW(8226))(0)
        If InStr(Info(2), ChrW(8226)) Then _
            r.Offset(, 2) = Split(Info(2), ChrW(8226))(1)
        
        '// 공격 및 방어력
        With XMLhttp
            .Open "Get", Range("B2").Value & ENCODEURL(r.Value), False
            .setRequestHeader "User-Agent", "Mozilla"
            .send
            .waitForResponse
            JsonStr = .responseText
        End With
        
        Set Json = VBAJSON.ParseJson(JsonStr)
        r.Offset(, 3) = Json("records")("total_ability")("attack_power_value")
        r.Offset(, 4) = Json("records")("total_ability")("max_hp")
 
 
        '// 장비
        With XMLhttp
            .Open "Get", Range("B3").Value & ENCODEURL(r.Value), False
            .setRequestHeader "User-Agent", "Mozilla"
            .send
            .waitForResponse
            JsonStr = .responseText
        End With
        
        Set Json = VBAJSON.ParseJson(JsonStr)
        For Each J In Json("records")
            If J("equipped_part") Like "hand" Then
                r.Offset(, 5) = J("item")("name")
            ElseIf J("equipped_part") Like "finger*" Then
                r.Offset(, 6) = J("item")("name")
            ElseIf J("equipped_part") Like "ear*" Then
                r.Offset(, 7) = J("item")("name")
            ElseIf J("equipped_part") Like "neck" Then
                r.Offset(, 8) = J("item")("name")
            ElseIf J("equipped_part") Like "bracelet" Then
                r.Offset(, 9) = J("item")("name")
            ElseIf J("equipped_part") Like "belt" Then
                r.Offset(, 10) = J("item")("name")
            ElseIf J("equipped_part") Like "gloves" Then
                r.Offset(, 11) = J("item")("name")
            ElseIf J("equipped_part") Like "soul" Then
                r.Offset(, 12) = J("item")("name")
            ElseIf J("equipped_part") Like "soul_2" Then
                r.Offset(, 13) = J("item")("name")
            ElseIf J("equipped_part") Like "pet" Then
                r.Offset(, 14) = J("item")("name")
            ElseIf J("equipped_part") Like "nova" Then
                r.Offset(, 15) = J("item")("name")
            ElseIf J("equipped_part") Like "soul_badge" Then
                r.Offset(, 16) = J("item")("name")
            ElseIf J("equipped_part") Like "swift_badge" Then
                r.Offset(, 17) = J("item")("name")
            ElseIf J("equipped_part") Like "body" Then
                r.Offset(, 18) = J("item")("name")
            ElseIf J("equipped_part") Like "head" Then
                r.Offset(, 19) = J("item")("name")
            ElseIf J("equipped_part") Like "eye" Then
                r.Offset(, 20) = J("item")("name")
            End If
        Next J
        
        '진행율 상태바에 표시
        Application.StatusBar = r.Row - 4 & " of " & lastRow - 4 & " : " _
            & Format((r.Row - 4) * 100 / (lastRow - 4), "00.00") & "% done..."
        
    Next r
    
    Range("A5:V" & lastRow).Columns.AutoFit
    Application.ScreenUpdating = True
    Application.StatusBar = False
    
DONE:
    Set Json = Nothing
    Set XMLhttp = Nothing
    Set Html = Nothing
End Sub
 
Function ENCODEURL(varText As Variant, Optional blnEncode = True)
    Static objHtmlfile As Object
    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        With objHtmlfile.parentWindow
            .execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
        End With
    End If
    If blnEncode Then
        ENCODEURL = objHtmlfile.parentWindow.encode(varText)
    End If
End Function

나머지는 첨부파일을 참고하세요.

매크로 허용하여 파일을 열어야 하고

Alt-F11 누르고 [도구-참조]에서  'Microsoft Html Object Library' 와 

'Microsoft Scripting Engine'에 반드시 체크가 되어 있어야 작동합니다.

XML관련은  체크하지 않아도 되지만 시스템에 xml60.dll 같은 DLL이 설치는 되어 있어야 합니다.

 * * 주 의 * * Wanring * *

웹사이트의 데이터를 과도하게 가져올 경우 해당 사이트에 무리가 갈 수 있음을 유의하세요.

새로고침을 반복적으로 누른다거나 너무 많은 캐릭터를 조회하지 마세요.

위 매크로는 웹사이트의 데이터를 가져오는 예시를 보여주기 위해서 시연 또는 학습목적으로만 작성되었습니다. 

문제가 될 경우 삭제, 수정될 수 있으며 개인적인 용도로만 사용하기 바랍니다.

원 데이터의 저작권은 해당 사이트와 해당 회사에 있습니다. 

Don't abuse this macro. Excessive use of this macro may harm the maintenace of the website.

This macro is for personal use only. The parsed data are all property of the related company. 

매크로 파일입니다.

BnS_Profile.xlsm

본 자료는 지식인 질문에 답변을 작성하다가 만들어졌습니다.

( https://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=318691565#answer1 )