vba [vba] 서울스토어(seoulstore) 크롤링 / Dictionary, JsonConverter
페이지 정보
본문
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(3, 3), 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
첨부파일
-
2020-09-07dirId102020101docId366508624전체순위검색_추가문의.xlsm (68.0K)
16회 다운로드 | DATE : 2020-09-08 01:13:04 -
JSON.bas (44.2K)
1회 다운로드 | DATE : 2022-10-16 16:04:09
- 이전글[vba] 조건부 서식이 걸린 셀 Display 색상 가져오기 20.09.08
- 다음글[vba] 두 영역에서 교차(중첩)하는 셀... 20.09.08
댓글목록
하나를하더라도최선을님의 댓글
하나를하더라도최선을 작성일
For Each k In o.keys
Debug.Print k, o(k)
Next k
하나를하더라도최선을님의 댓글
하나를하더라도최선을 작성일
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