관련: 지식인
검색어가 400개 이상으로 많고 서버에 부담도 줄이기 위해서는
네이버에서 제공하는 API를 이용해서 조회하여야겠습니다.
네이버 로그인한 후에 아래 사이트를 방문합니다.
https://developers.naver.com/apps/#/register?defaultScope=search
아래처럼 API 이용 신청을 합니다. 애플리케이션 이름은 자신이 원하는 이름으로 입력하세요.
이제 Client ID와 Client Secret 이 발급되었습니다. 잘 복사해 놓으세요. 하루 할당량은 25,000회로 제한됩니다.
어떻게 작동하는지 PlayGround에서 연습해볼 수 있습니다.
쇼핑 검색의 경우 https://openapi.naver.com/v1/search/shop.json?display=1&start=1&sort=sim&query=사과 와 같은 식으로 검색합니다.
아래와 같은 API 호출 결과 JSON 데이터를 잘 파싱하면 되겠습니다. 원하는 값은 total 값입니다.
여기서는 참고로 Display=1로 하나의 품목만 검색해서 그 결과도 출력하도록 했습니다.
''
''{
'' "lastBuildDate": "Mon, 19 Feb 2024 23:30:42 +0900",
'' "total": 1388780,
'' "start": 1,
'' "display": 1,
'' "items": [
'' {
'' "title": "<b>사과</b> 가정용 선물세트 못난이 홍로 부사 감홍 시나노골드 황금<b>사과</b> 꿀<b>사과</b>",
'' "link": "https://search.shopping.naver.com/gate.nhn?id=82754642762",
'' "image": "https://shopping-phinf.pstatic.net/main_8275464/82754642762.11.jpg",
'' "lprice": "22900",
'' "hprice": "",
'' "mallName": "과일꾼",
'' "productId": "82754642762",
'' "productType": "2",
'' "brand": "과일꾼",
'' "maker": "",
'' "category1": "식품",
'' "category2": "농산물",
'' "category3": "과일",
'' "category4": "사과"
'' }
'' ]
''}
엑셀에서 Alt-F11 코드 창을 엽니다.
먼저 Json 을 파싱하기 위한 클래스를 가져와서 삽입합니다.
위 링크에서 JsonBag Treeview.zip 파일을 다운 받아서 JsonBag.cls 파일을 압축을 풀어서 프로젝트 창으로 드래그 합니다.
삽입 > 모듈을 추가하고 Module1에 아래 코드를 붙여 넣습니다.
*** Client_ID 와 Client_Secret 은 반드시 자신의 것으로 고치셔야 합니다. ***
Option Explicit
Const Client_ID = "자신의 Client ID 값"
Const Client_Secret = "Client 비밀번호"
Dim Http As Object 'MSXML2.ServerXMLHTTP60 ' Object
Dim JSON As New JsonBag
Const RESCAN As Boolean = False '모든 검색어 재검색 여부
Sub getStatistics()
Dim sht As Worksheet
Dim lastRow As Range, rng As Range
Dim rr As Long
Set Http = CreateObject("MSXML2.ServerXMLHttp")
Set sht = ActiveSheet
Set lastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp)
If lastRow.Row < 2 Then Exit Sub
If RESCAN Then sht.Hyperlinks.Delete
For Each rng In sht.Range("A2:A" & lastRow.Row)
If RESCAN Or (Not RESCAN And rng.Offset(, 1) = "") Then
rng.Offset(, 1).Resize(, 5).ClearContents
rr = rr + 1
Application.StatusBar = "Processing " & rr & "(" & _
Format(((rng.Row - 1) * 100) / (lastRow.Row - 1), "00.00") & "%)..."
If getStat(rng) = -1 Then Exit For
If rr Mod 5 = 0 Then Application.Wait Now + TimeValue("00:00:01")
End If
Next rng
sht.Columns.AutoFit
sht.Columns("C").ColumnWidth = 40
sht.Rows.AutoFit
Application.StatusBar = "Total " & rr & " items processed."
Application.OnTime Now + TimeValue("00:00:05"), "zStatusOff"
Set Http = Nothing
Set JSON = Nothing
End Sub
Function getStat(keyWord As Range) As Integer
Dim oSht As Worksheet
Dim sUrl As String
Dim itemCount$, Title$, Link$, Image$, lPrice$, mallName$
'호출방법 참고: https://developers.naver.com/docs/serviceapi/search/shopping/shopping.md#%EC%87%BC%ED%95%91
sUrl = "https://openapi.naver.com/v1/search/shop.json?display=1&start=1&sort=sim&query=" & ENCODEURL(Trim(keyWord.Text))
With Http
.Open "Get", sUrl, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Linux; Android 6.0;) AppleWebKit/537.36 Chrome/120.0.0.0 Mobile Safari/537.36"
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "HOST", "openapi.Naver.com"
.setRequestHeader "x-Naver-Client-ID", Client_ID
.setRequestHeader "x-Naver-Client-Secret", Client_Secret
.send
JSON.JSON = .responseText
End With
''
''{
'' "lastBuildDate": "Mon, 19 Feb 2024 23:30:42 +0900",
'' "total": 1388780,
'' "start": 1,
'' "display": 1,
'' "items": [
'' {
'' "title": "<b>사과</b> 가정용 선물세트 못난이 홍로 부사 감홍 시나노골드 황금<b>사과</b> 꿀<b>사과</b>",
'' "link": "https://search.shopping.naver.com/gate.nhn?id=82754642762",
'' "image": "https://shopping-phinf.pstatic.net/main_8275464/82754642762.11.jpg",
'' "lprice": "22900",
'' "hprice": "",
'' "mallName": "과일꾼",
'' "productId": "82754642762",
'' "productType": "2",
'' "brand": "과일꾼",
'' "maker": "",
'' "category1": "식품",
'' "category2": "농산물",
'' "category3": "과일",
'' "category4": "사과"
'' }
'' ]
''}
If JSON.Exists("errorCode") Then
If MsgBox("[ Error!! " & JSON("errorCode") & " ] " & JSON("errorMessage") & _
vbNewLine & vbNewLine & "Stop now?", vbYesNo + vbCritical) = vbYes Then
getStat = -1
Else
getStat = 0
End If
Exit Function
End If
itemCount = JSON("total")
keyWord.Offset(, 1) = itemCount
keyWord.Offset(, 1).NumberFormat = "###,###,###,##0"
If itemCount > 0 And JSON.Exists("items") Then
Title = JSON("items")(1)("title")
Title = Replace(Title, "<b>", ""): Title = Replace(Title, "</b>", "")
Link = JSON("items")(1)("link")
Image = JSON("items")(1)("image")
lPrice = JSON("items")(1)("lprice")
mallName = JSON("items")(1)("mallName")
Set oSht = keyWord.Parent
keyWord.Offset(, 2) = Title
keyWord.Offset(, 2).Hyperlinks.Add keyWord.Offset(, 2), Link
keyWord.Offset(, 3) = "img"
keyWord.Offset(, 3).Hyperlinks.Add keyWord.Offset(, 3), Image
keyWord.Offset(, 4) = lPrice
keyWord.Offset(, 4).NumberFormat = "###,###,###,###"
keyWord.Offset(, 5) = mallName
End If
End Function
Sub zStatusOff()
Application.StatusBar = False
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-F8을 눌러서 getStatistics 매크로를 실행해서 검색을 시작합니다.
아니면 소스에서 RESCAN = True 로 바꾸면 검색결과가 있는 것도 모두 다시 검색합니다.
상태 표시줄에 검색개수와 진행률을 보여줍니다.
5개마다 1초씩 쉬도록 했습니다. 그렇지 않으면 타이밍 에러가 발생합니다.
*** Client_ID 와 Client_Secret 를 수정하지 않으면 아래와 같이 오류가 발생합니다. 반드시 자신의 것으로 고치셔야 합니다. ***
샘플 파일 첨부합니다.
'XLS+VBA' 카테고리의 다른 글
엑셀연동] 자동 방배정 및 명단 출력 2 (0) | 2024.05.23 |
---|---|
엑셀연동] 방배정 명단 출력 1 (0) | 2024.05.23 |
교보문고 ISBN 도서 검색(JSON) (1) | 2024.05.15 |
모든 행 값을 랜덤으로 섞기 (1) | 2024.03.01 |
엑셀에서 실시간 유튜브 구독자수 모니터링 (0) | 2024.02.15 |
온라인 이미지를 다운로드하여 아래로 이어 붙인 상품 이미지 일괄 생성 (0) | 2024.02.14 |
엑셀에서 ppt의 특정 페이지를 링크 (0) | 2023.11.21 |
juso.go.kr이용 한글주소 ↔ 영어주소 변환 (0) | 2023.06.15 |
최근댓글