[vba] 서울스토어(seoulstore) 크롤링 / Dictionary, JsonConverter > vb6.0/vba

본문 바로가기

vb6.0/vba

[vba] [vba] 서울스토어(seoulstore) 크롤링 / Dictionary, JsonConverter

회원사진
하나를하더라도최선을
2020-09-08 01:13 6,285 2
  • - 첨부파일 : 2020-09-07dirId102020101docId366508624전체순위검색_추가문의.xlsm (68.0K) - 다운로드
  • - 첨부파일 : JSON.bas (44.2K) - 다운로드

본문




Sub program1472_com()
    ActiveSheet.Pictures.Delete
    Dim URL As String, T As String, PostData As String, cookie As String
    Dim O As Object, items As Object, C As Range
    Dim i As Integer, s As Variant
    Dim key As String, itype As String, value As String
    For Each C In Range(Cells(33), Cells(Rows.Count, 3).End(3))
        PostData = "keyword=" & C
        PostData = PostData & "&start=0"
        PostData = PostData & "&count=12"
        PostData = PostData & "&method=search"
        PostData = PostData & "&accessToken="
        With CreateObject("WinHttp.WinHttpRequest.5.1")
            .Open "POST", URL
            .setRequestHeader "Host""www.seoulstore.com"
            .setRequestHeader "User-Agent""Mozilla/5.0 (Windows NT 10.0; WOW64; rv:56.0) Gecko/20100101 Firefox/56.0"
            .setRequestHeader "Accept""application/json, text/javascript, */*; q=0.01"
            .setRequestHeader "Accept-Language""ko-KR,ko;q=0.8,en-US;q=0.5,en;q=0.3"
            .setRequestHeader "Content-Type""application/x-www-form-urlencoded; charset=UTF-8"
            .setRequestHeader "X-Requested-With""XMLHttpRequest"
            .setRequestHeader "Content-Length", Len(PostData)
            .setRequestHeader "Origin""https://www.seoulstore.com"
            .setRequestHeader "Connection""keep-alive"
            .setRequestHeader "Referer", URL
            If Len(cookie) Then .setRequestHeader "Cookie", cookie
            .setRequestHeader "TE""Trailers"
            .send PostData
            .waitForResponse: DoEvents
    '         cookie = SetCookie(cookie, .getAllResponseHeaders)
            T = .responseText
            'T = StrConv(.ResponseBody, vbUnicode)
        End With
        Set O = ParseJson(T)
        For Each items In O("products")("items")
            Debug.Print items("images")("list")
            For i = 0 To items.Count - 1
                key = items.Keys()(i)
                itype = TypeName(items(key)): value = ""
                Select Case itype
                    Case "Dictionary": value = "Dictionary"
                    Case "Collection"
                        For Each s In items(key)
                            If Len(value) Then value = value & ", "
                            value = value & s
                        Next
                    Case Else: value = items(key)
                End Select
                Debug.Print key, value
            Next
            Stop
        Next
    Next
End Sub

 

댓글목록2

익명글님의 댓글

익명
2022-02-19 14:50
For Each k In o.keys

        Debug.Print k, o(k)

    Next k

익명글님의 댓글

익명
2022-02-19 14:50
Set http = CreateObject("MSXML2.XMLHTTP")

    http.Open "GET", "https://www.alphavantage.co/query?" & _

          "function=CURRENCY_EXCHANGE_RATE&from_currency=USD" & _

          "&to_currency=JPY&apikey=demo", False



    http.Send
게시판 전체검색