관련: 지식인

 

검색어가 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 을 파싱하기 위한 클래스를 가져와서 삽입합니다.

https://www.vbforums.com/showthread.php?738845-VB6-JsonBag-Another-JSON-Parser-Generator&p=5366455&viewfull=1#post5366455

위 링크에서 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 를 수정하지 않으면 아래와 같이 오류가 발생합니다. 반드시 자신의 것으로 고치셔야 합니다. ***