네이버 지도 검색 결과 엑셀 수집

네이버지도검색 결과를 엑셀로 수집하는 매크로입니다.

 

검색어를 입력하고 

오른쪽 단위와 제한 갯수를 설정하고 Naver 지도 검색을 누르면 됩니다.

 

서울 롯데리아 검색화면:

검색된 상호를 클릭하면 웹브라우저에 해당 위치를 보여줍니다.

 

강원도 영화촬영지 검색 화면:

 

부산 맛집 검색화면:

 

특히 맛집, 주유소 등을 검색할 때 유용하겠습니다.

 

'Alt-F11 도구-참조에서 Microsoft XML x.0 Object Library,
'Microsoft Scripting Runtime Library에 미리 체크

Option Explicit

    
Sub Automate()
    Dim sht As Worksheet
    Dim lastRow As Long
    Dim r As Range
    Dim page As Integer
    
    Set sht = ActiveSheet
    
    '기존 자료 삭제
    lastRow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
    sht.Range("A4:Z" & lastRow + 1).ClearContents
    
    sht.Hyperlinks.Delete
    
    '자료 가져오기
    If [B1] = "" Then
        MsgBox "검색어를 입력하세요.(예:서울 중국집)"
        [B1].Select
    ElseIf [F1] >= 1 And [F1] <= 100 And [F2] >= 1 And [F2] <= 1000 Then
    
        For page = 1 To Int(([F2] / [F1]) + 0.5)
        
            If page > 1 Then  ' And page Mod 2 = 1 Then  ' 페이지 마다 쉬기
                Application.StatusBar = Application.StatusBar & " - Pausing for 2 sec..."
                Application.Wait Now + TimeValue("00:00:02")
            End If
            Application.StatusBar = "Searching page: " & page & "..."
            '출력시트, 검색어, 페이지당 개수, 제한개수
            If SearchNaverMap(sht, [B1], [F1], page) = 0 Then Exit For
            
        Next page
    Else
        [F2].Select
        MsgBox "개수 단위는 1개이상 100개이하이며" & vbNewLine & vbNewLine _
            & "총 제한개수는 1개이상 1000개 이하여야합니다. "
    End If
    Application.StatusBar = False
    
End Sub

Function SearchNaverMap(shtTarget As Worksheet, strSearch As String, _
    Optional iCount As Integer = 20, Optional iPage As Integer = 1) As Long

    Dim http As Object 'New MSXML2.XMLHTTP
    Dim Json As Dictionary  'Object
    Dim jValue As Dictionary, v As Variant
    Dim i As Integer
    Dim URL As String, URl2 As String, temp As String
    Dim startRow As Long
     
    On Error Resume Next
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    URl2 = "https://map.naver.com/v5/search/" & strSearch & "/place/"
    URL = "https://map.naver.com/v5/api/search?caller=pcweb&query=&type=all&page=1&displayCount=20&isPlaceRecommendationReplace=true&lang=ko"
    URL = Replace(URL, "&query=", "&query=" & ENCODEURL(strSearch))
    If iPage = 0 Then iPage = 1
    URL = Replace(URL, "&page=1", "&page=" & iPage)
    If iCount = 0 Then iCount = 20
    If iCount > 100 Then iCount = 100  '최대 100개씩
    URL = Replace(URL, "&displayCount=20", "&displayCount=" & iCount)
    Debug.Print URL
    
    '접속
    With http
        .Open "get", URL, False
        .setRequestHeader ": authority", "Map.naver.com"
 
        .setRequestHeader "content-type", "application/json"
        .setRequestHeader "user-agent", "Mozilla/5.0"
        .setRequestHeader "referer", "https://map.naver.com/"
        '.setRequestHeader "cookie", "hide_intro_popup=true; NNB=YB4ZCP2KPBQF3; BMR=s=1682410501834&r=&r2=; " & _
            "nid_inf=-1200312348; NID_AUT=dDyW/jafIlmW8RZYFO/qx0sibaRZ; " & _
            "NID_JKL=bj17HrEtZWoAlqRks=; _ga_7VKFYR6RV1=GS1.1.1.0.1.60; _ga=GA1.2..; _gid=GA1.2..; " & _
            "NID_SES=AAABvjvT3; _naver_usersession_=zjDUtGtcOJ; page_uid=UE5yLlpy8ejBsd9oyAK-014447; csrf_token=dc6c34e04198ab0f1ae"
        .send
        If InStr(.responseText, "Redirecting") Then _
            MsgBox "Due to too many connections, this IP is blocked by server!!"
        If Len(.responseText) < 500 Then SearchNaverMap = 0: Set http = Nothing: Exit Function
        'Json 파싱
        Set Json = JsonConverter.ParseJson(.responseText)

    End With
    
    '에러 발생 '//{"error":{"code":"XE400","msg":"Bad Request."
    'If Json.Keys(0) = "error" Then SearchNaverMap = 0: Set http = Nothing: Exit Function
    
    '맨 아래 행
    startRow = shtTarget.Cells(shtTarget.Rows.Count, "B").End(xlUp).Row + 1
    
    For Each jValue In Json("result")("place")("list")
    
        '연번
        shtTarget.Cells(startRow + i, "A") = (iPage - 1) * iCount + i + 1
        
        '상호명
        shtTarget.Cells(startRow + i, "B") = jValue("name")
        '하이퍼링크
        shtTarget.Hyperlinks.Add shtTarget.Cells(startRow + i, "B"), URl2 & jValue("id")
        
        '구분
        shtTarget.Cells(startRow + i, "C") = jValue("category")(jValue("category").Count)
        
        '주소
        shtTarget.Cells(startRow + i, "D") = jValue("address")

        '전화
        shtTarget.Cells(startRow + i, "E") = jValue("tel")
       
        '태그
        temp = ""
        For Each v In jValue("context"): temp = temp & v & ",": Next v
        If Right(temp, 1) = "," Then temp = Left(temp, Len(temp) - 1)
        shtTarget.Cells(startRow + i, "F") = temp

        '리뷰
        shtTarget.Cells(startRow + i, "G") = jValue("reviewCount")

        i = i + 1
        
    Next jValue
    
    shtTarget.Cells.Columns.AutoFit
    
Oops:
    If Not http Is Nothing Then Set http = Nothing
    If Err Then MsgBox Err.Description
    SearchNaverMap = i
    
End Function


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

Function DECODEURL(varText As Variant, Optional blnEncode = True)
    Static objHtmlfile As Object
    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        With objHtmlfile.parentWindow
            .execScript "function decode(s) {return decodeURIComponent(s)}", "jscript"
        End With
    End If
    If blnEncode Then
        DECODEURL = objHtmlfile.parentWindow.decode(varText)
    End If
End Function

 

VBAJSON 라이브러리를 이용했습니다.

코드는 위와 같이 공개하지만 남용을 조금이라도 막고자 모듈에 암호가 걸려있습니다.

 

주1) 서버에 부담을 줄이기 위해 한번 검색 후 약간의 시간을 두었습니다.

주2) 본 자료는 웹사이트 HTML분석과 크롤링에 대한 교육용 단순샘플로 검색자료의 저작권은 해당저작권자의 소유임을 밝힙니다.

주3) HTML소스나 JSON자료구조가 변경되면 작동하지 않습니다. 

 

 

네이버지도검색3Restricted20200307.xlsm

0.09MB

 

카테고리별로 정렬할 수 있는 버전입니다.

특히 리뷰순으로 정렬을 선택하면 리뷰 많은 곳 우선으로 정렬합니다. 나머지 카테고리는 올림차순 정렬입니다.

 

네이버지도검색4_Restricted.xlsm

0.08MB

 

ㅇ우편번호까지 검색하는 버전입니다. [2023.08.08]

 

지식인 답변에는 올렸었는데 여기에는 이제야 올립니다.

우편번호 검색은 시간이 걸립니다. 서버 부담을 줄이기 위해 대기시간도 걸었습니다.

※ 서버 자료/코드 변동시 언제라도 작동이 안될 수 있습니다.

 

 

네이버지도검색4_Restricted_ZipCode1.xlsm

0.08MB

(For Loop초기화 에러가 나는 경우가 있어 Dictionary 선언할 때 초기화되도록 New 구분자를 추가했습니다.)

 

 

ㅇ우편번호 가져오는 데 실패하면 juso.go.kr을 이용한 아래 방법으로 우편번호를 가져오세요. 마지막 건물이름은 삭제해야 검색 성공확률이 높습니다.

 

https://konahn.tistory.com/entry/jusogokr

juso.go.kr이용 한글주소 ↔ 영어주소 변환