길찾기 GETHTTP URL 관련 오류 문의드립니다.

VBA
작성자
고병관
작성일
2021-09-11 01:46
조회
44
엑셀버전 : 엑셀2016

운영체제 : 윈도우10

안녕하세요 크롤링강의를 보고 최단거리 구연을 하고자 하는 사람입니다

현재 구상하는 바는 주소 2개를 넣으면 네이버 길찾기의 최단거리를 이용해 여러 주소의 최단거리를 아는 프로그램을 만들고자 합니다

 

이 과정에서 gethttp 에 대해서 봤는데 아래 사진과 같이 https://m.map.naver.com/apis/search/poi?query=서울시 롯데월드 이런식으로

검색하면 크롬 웹페이지에서는 이에 관련된 정보에 대한 텍스트들이 쭉 나옵니다.

그러나 올려주신 gethttp 함수에서 그대로 주소를 넣으면 { "error": { "code": "LE0320", "msg": "검색된 결과가 없습니다.", "displayMsg": "검색된 결과가 없습니다.", "extraInfo": null } } 이런식으로 마치 검색한 주소가 없을때 나오는 오류 메시지가 뜹니다

분명 같은 주소를 크롬 창에 복사하여 넣으면 여러가지 데이터들이 있는데.. gethttp활용을 하면 저렇게 query = 다음에 아무것도 입력하지 않는듯한 오류가 나는지 모르겠습니다.

 

아래 첨부 사진있으니 보시고.ㅜ 불쌍한 저를 도와주시면 감사하겟습니다.

 

화면-캡처-2021-09-11-013912.png

회원등급 : 새싹등급
포인트 : 96 EP
총질문 : 4 개 (마감율 : 75%)
채택답변 : 0 개
전체 3

  • 2021-09-11 03:31
    채택된 답변

    안녕하세요?^^

    해당 URL은 쿼리를 URL주소로 인코딩해서 입력해주셔야 합니다.

    아래 코드를 사용해보세요.

    최단거리 프로그램이라니, 너무 유용할 것 같습니다. 🙂 완성된 파일을 같이 공유해주시면 너무 좋을 것 같아요~^^

    Sub test()
    
    
    Dim sTarget As String
    sTarget = "서울시 롯데월드 "
    sTarget = ENCODEURL(sTarget)
    
    MsgBox GetHttp("https://m.map.naver.com/apis/search/poi?query=" & sTarget).body.innerhtml
    
    End Sub
    
    Function GetHttp(URL As String, Optional formText As String, _
                                    Optional isWinHttp As Boolean = False, _
                                    Optional RequestHeader As Variant, _
                                    Optional includeMeta As Boolean = False, _
                                    Optional RequestType As String = "GET") As Object
     
    '###############################################################
    '오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
    '▶ GetHttp 함수
    '▶ 웹에서 데이터를 받아옵니다.
    '▶ 인수 설명
    '_____________URL                         : 데이터를 스크랩할 웹 페이지 주소입니다.
    '_____________formText                 : Encoding 된 FormText 형식으로 보내야 할 경우, Send String에 쿼리문을 추가합니다.
    '_____________isWinHttp               : WinHTTP 로 요청할지 여부입니다. Redirect가 필요할 경우 True로 입력하여 WinHttp 요청을 전송합니다.
    '_____________RequestHeader       : RequestHeader를 배열로 입력합니다. 반드시 짝수(한 쌍씩 이루어진) 개수로 입력되어야 합니다.
    '_____________includeMeta           : TRUE 일 경우 HTML 문서위로 ResponseText를 강제 입력합니다. Meta값이 포함되어 HTML이 작성되며 innerText를 사용할 수 없습니다. 기본값은 False 입니다.
    '_____________RequestType           : 요청방식입니다. 기본값은 "GET"입니다.
    '▶ 사용 예제
    'Dim HtmlResult As Object
    'Set htmlResult = GetHttp("https://www.naver.com")
    'msgbox htmlResult.body.innerHTML
    '###############################################################
     
    Dim oHTMLDoc As Object: Dim objHTTP As Object
    Dim HTMLDoc As Object
    Dim i As Long: Dim blnAgent As Boolean: blnAgent = False
    Dim sUserAgent As String: sUserAgent = "Mozilla/5.0 (Linux; Android 6.0; Nexus 5 Build/MRA58N) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.183 Mobile Safari/537.36"
     
    Application.DisplayAlerts = False
     
    If Left(URL, 4) <> "http" Then URL = "http://" & URL
     
    Set oHTMLDoc = CreateObject("HtmlFile")
    Set HTMLDoc = CreateObject("HtmlFile")
     
    If isWinHttp = False Then
        Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Else
        Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    End If
     
    objHTTP.setTimeouts 3000, 3000, 3000, 3000
    objHTTP.Open RequestType, URL, False
    If Not IsMissing(RequestHeader) Then
        Dim vRequestHeader As Variant
        For Each vRequestHeader In RequestHeader
            Dim uHeader As Long: Dim Lheader As Long: Dim steps As Long
            uHeader = UBound(vRequestHeader): Lheader = LBound(vRequestHeader)
            If (uHeader - Lheader) Mod 2 = 0 Then GetHttp = CVErr(xlValue): Exit Function
            For i = Lheader To uHeader Step 2
                If vRequestHeader(i) = "User-Agent" Then blnAgent = True
                objHTTP.setRequestHeader vRequestHeader(i), vRequestHeader(i + 1)
            Next
        Next
    End If
    If blnAgent = False Then objHTTP.setRequestHeader "User-Agent", sUserAgent
     
    objHTTP.send formText
     
    If includeMeta = False Then
        With oHTMLDoc
            .Open
            .Write objHTTP.responseText
            .Close
        End With
    Else
        oHTMLDoc.body.innerhtml = objHTTP.responseText
    End If
     
    Set GetHttp = oHTMLDoc
    Set oHTMLDoc = Nothing
    Set objHTTP = Nothing
     
    Application.DisplayAlerts = True
     
    End Function
    
    Function ENCODEURL(varText As Variant, Optional blnEncode = True)
     
    '############################################################
    '한글/영문 텍스트를 URL 주소로 변경합니다.
    'https://www.oppadu.com/vba-encodeurl-함수/
    '############################################################
     
    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
    

     


    • 2021-09-12 01:45

      감사합니다.~~~ 알려주신 URL 인코딩 함수 하나로 모든 논리를 구현했습니다.

      gethttp 함수와 네이버 연관검색어 크롤링 강의를 참고하였습니다.

      strSearch_start = Sheet3.Range("A" & i).Value
      strSearch_start = ENCODEURL(strSearch_start)

      URL = "https://m.map.naver.com/apis/search/poi?query=" & strSearch_start

      Set htmlResult = GetHttp(URL)
      strResult = htmlResult.body.innerHTML

      strResult_x_start = Splitter(strResult, """x"": """, """,")
      strResult_y_start = Splitter(strResult, """y"": """, """,")

      이렇게 하면 strResult_x_start, y_start 에는 입력시킨 주소에 GPS x, y좌표를 받아옵니다.

      이렇게 받은 시작점 , 끝점 x ,y 좌표를 길찾기 URL에 적당히 넣으면 됩니다.

      URL = "https://m.map.naver.com/spirra/findCarRoute.naver?route=route3&output=json&result=web3&coord_type=latlng&search=0&car=0&mileage=12.4&start=" & strResult_x_start & "%2C" & strResult_y_start & "&destination=" & strResult_x_det & "%2C" & strResult_y_det

      원래 좌표값 넣는것 뒤에 한글 주소들이 들어가는데 그건 빼도 무방했습니다.

      위에 URL에서  다른것 보단 search=0 이부분이 0이면 최단거리 2면 추천거리 등으로 조건을 바꿀 수 있는 부분입니다.

      아마 car=0 부분도 숫자를 넣으면 조건이 변경될것으로 판단됩니다. 이 부분은 제가 해석까지는 못했습니다.

      그 이후 start , destination 이부분에 각각의 좌표들이 들어가고 x 와 y 좌표의 구부은 %2C로 하더라고요.

      %2C 는 아마 구분을 나타내는 코드일것 같습니다.

      결론으로 URL = "https://m.map.naver.com/spirra/findCarRoute.naver?route=route3&output=json&result=web3&coord_type=latlng&search=0&car=0&mileage=12.4& 여기 까지는 그대로 가고

      start=x좌표 %2C y좌표 & destination = x좌표 %2C y좌표 이런식으로 진행합니다.

      마지막으로 splitter 이용해서 아래와 같이 잘라주면 거리를 구할 수 있네요

      str_min_dis = Splitter(strResult, """distance"":", ",")

      이걸 for문 돌려서 전체 시트에 적용하면 결과를 얻을 수 있었습니다

       

      아래는 전체 소스코드입니다.

      함수명을 그대로 가져다 쓰고 중간중간 주석달아놓은거 있어서.. 엑셀로 옮겨서 보시기 바랍니다.

       

      Sub 연관검색어()

      ' 변수 설정
      Dim URL As String
      Dim htmlResult As Object '<- GetHTTP 명령문의 결과값 ... >> HTML 문서
      Dim strResult As String '<-htmlResult 에서 받아온 HTML 문자열
      Dim strResult_x_start As String
      Dim strResult_y_start As String
      Dim strSearch_start As String '<- 검색단어
      Dim strSearch_det As String '<- 검색단어
      Dim strResult_x_det As String
      Dim strResult_y_det As String
      Dim str_min_dis As String

      Dim v As Variant

      Dim i As Long

      'strSearch = Sheet3.Range("C2").Value

      For i = 2 To Sheet3.Range("A10000").End(xlUp).Row

      'Sheet3.Range("A" & i).Value

      strSearch_start = Sheet3.Range("A" & i).Value
      strSearch_start = ENCODEURL(strSearch_start)

      URL = "https://m.map.naver.com/apis/search/poi?query=" & strSearch_start

       

      'Debug.Print URL

      Set htmlResult = GetHttp(URL)
      strResult = htmlResult.body.innerHTML

      'MsgBox strResult

       

      strResult_x_start = Splitter(strResult, """x"": """, """,")
      strResult_y_start = Splitter(strResult, """y"": """, """,")

      strSearch_det = Sheet3.Range("B" & i).Value
      strSearch_det = ENCODEURL(strSearch_det)

      URL = "https://m.map.naver.com/apis/search/poi?query=" & strSearch_det
      Set htmlResult = GetHttp(URL)
      strResult = htmlResult.body.innerHTML

      strResult_x_det = Splitter(strResult, """x"": """, """,")
      strResult_y_det = Splitter(strResult, """y"": """, """,")

       

      'MsgBox strResult_x_start & "," & strResult_y_start & "," & strResult_x_det & "," & strResult_y_det

      URL = "https://m.map.naver.com/spirra/findCarRoute.naver?route=route3&output=json&result=web3&coord_type=latlng&search=0&car=0&mileage=12.4&start=" & strResult_x_start & "%2C" & strResult_y_start & "&destination=" & strResult_x_det & "%2C" & strResult_y_det
      Set htmlResult = GetHttp(URL)
      strResult = htmlResult.body.innerHTML

      str_min_dis = Splitter(strResult, """distance"":", ",")

      Sheet3.Cells(i, 3) = str_min_dis * 0.001

      Next i

       

      'MsgBox str_min_dis

       

       

       

       

       

       

      '▶ 사용 예제
      'Dim s As String
      's = "{sa;b132@drama#weekend;aabbcc"
      's = Splitter(s, "@", "#")
      'msgbox s '--> "drama"를 반환합니다.
      '###############################################################

      'v = Split(strResult, ",")

      'For i = LBound(v) To UBound(v)
      ' v(i) = Replace(Replace(v(i), "[""", ""), """]", "")
      'Next

      'ArrayToRng Sheet3.Range("A1"), v

      End Sub

       


      • 2021-09-15 16:42

        완성된 코드까지! 😍 감사합니다

        실례가 안된다면 이 코드를 최신자료 공유페이지에 공유해도 괜찮을까요?


전체 4,001
번호 카테고리 제목 작성자 작성일 추천 조회
3985 피벗테이블
New (도움바랍니다)한명의 대표가 다수의 사업장을 운영하는 경우
일랑일랑 | 11:31 | 추천 0 | 조회 2
일랑일랑 11:31 0 2
3984 함수/공식
New 함수 만들 수 있을까요?
soo | 09:47 | 추천 0 | 조회 6
soo 09:47 0 6
3983 VBA
New 엑셀 VBA에서 RemoveDuplicates 사용시 '5' 런타임 오류가 발생하여 해결 방법 문의드립니다. (1)
namonamo | 02:14 | 추천 0 | 조회 8
namonamo 02:14 0 8
3982 함수/공식
New (도와주세요) INDEX, MATCH 를 통해 만들었는데 많이 무거워요ㅠ 첨부파일 (3)
18 강영순 | 02:07 | 추천 0 | 조회 18
18 강영순 02:07 0 18
3981 VBA
New 재고관리 툴 만들기 8시간 풀영상 중 목록상자 가시성과 다중페이지에 대해 질문합니다.
나두엑셀왕 | 2021.09.18 | 추천 0 | 조회 11
나두엑셀왕 2021.09.18 0 11
3980 기능/도구
New 목록 단추 차수 조회를 피벗테이블과 연동해서 총괄표 조회 할때 에러 발생 해결 부탁드려요~~ 첨부파일 (1)
알면서 | 2021.09.18 | 추천 0 | 조회 11
알면서 2021.09.18 0 11
3979 파워쿼리/피벗
New 웹데이터 엑셀로 가져오기 (1)
yoo | 2021.09.18 | 추천 -1 | 조회 28
yoo 2021.09.18 -1 28
3978 기능/도구
New 아이콘을 매뉴에 저장하는 방법 문의 (1)
Trimman | 2021.09.18 | 추천 0 | 조회 20
Trimman 2021.09.18 0 20
3977 VBA
New 선택 행 강조 매크로 사용시 복사/붙여넣기 할 수 있는 방법 있을까요? (1)
차오 | 2021.09.17 | 추천 0 | 조회 30
차오 2021.09.17 0 30
3976 함수/공식
New index/match 함수 사용시 다중 데이터을 합산하여 데이터 합계 끌고오는 방법이 있을까요? 첨부파일 (1)
관절바람 | 2021.09.17 | 추천 0 | 조회 28
관절바람 2021.09.17 0 28
3975 VBA
New VBA 시트명을 참조하는 함수입력 매크로에서 시트명을 변수로 설정하는 방법 (1)
kimki**** | 2021.09.17 | 추천 0 | 조회 24
kimki**** 2021.09.17 0 24
3974 함수/공식
New [카운팅 함수 해결방법] 고수님들 아무쪼록 가르침을 주시면 감사하겠습니다! 첨부파일 (2) 답변완료
CreativeGil | 2021.09.17 | 추천 0 | 조회 36
CreativeGil 2021.09.17 0 36
3973 함수/공식
New 일자/품목 열 행으로 나눠져 있는 자료 끌고오기 (1)
top**** | 2021.09.17 | 추천 0 | 조회 30
top**** 2021.09.17 0 30
3972 함수/공식
New 엑셀 함수 질문 첨부파일
향기 | 2021.09.17 | 추천 0 | 조회 38
향기 2021.09.17 0 38
3971 VBA
New VBA 로 만든 임시 POS에서, 바코드 열과 날짜 추가하는 방법 문의 드립니다 첨부파일 (1)
효율 | 2021.09.17 | 추천 0 | 조회 34
효율 2021.09.17 0 34
3970 기능/도구
New 스프레드시트 복사 붙여넣기 큰따옴표 지우는법 알려주실분 (1)
제비제비 | 2021.09.17 | 추천 0 | 조회 16
제비제비 2021.09.17 0 16
3969 VBA
New 동영상 처럼 엑셀로 만들어 질까요? (1)
yoo | 2021.09.16 | 추천 0 | 조회 39
yoo 2021.09.16 0 39
3968 VBA
New 기준열로 데이터 댕겨주기 질문 첨부파일 (2) 답변완료
H.B | 2021.09.16 | 추천 0 | 조회 35
H.B 2021.09.16 0 35
3967 기능/도구
New 다른 시트 참조 자동 계산 (1)
skyline | 2021.09.16 | 추천 0 | 조회 44
skyline 2021.09.16 0 44
3966 함수/공식
New 엑셀 함수 질문 첨부파일 (1)
향기 | 2021.09.16 | 추천 0 | 조회 25
향기 2021.09.16 0 25
3965 VBA
New 재질문 줄바꿈, 배열쪼개기 (2) 답변완료
H.B | 2021.09.16 | 추천 0 | 조회 37
H.B 2021.09.16 0 37
3964 VBA
New 폴더내 모든파일의 '특정시트' '각 파일' 제일 앞 시트로 복사
강대국 | 2021.09.16 | 추천 0 | 조회 22
강대국 2021.09.16 0 22
3963 VBA
New 사용자지정함수 관련 문의 입니다.
Nir | 2021.09.16 | 추천 0 | 조회 22
Nir 2021.09.16 0 22
3962 파워쿼리/피벗
파워쿼리 열 추가 첨부파일 (2)
슝슝 | 2021.09.16 | 추천 0 | 조회 24
슝슝 2021.09.16 0 24
3961 함수/공식
"월"&"주 차별" 관련 문의 드립니다 ㅠㅠ!! 첨부파일 (2) 답변완료
송민정 | 2021.09.16 | 추천 0 | 조회 39
송민정 2021.09.16 0 39
3960 VBA
표 데이터 다른표에 복사 붙여넣기 하는 매크로 첨부파일
이도현 | 2021.09.16 | 추천 0 | 조회 21
이도현 2021.09.16 0 21
3959 VBA
Range 안에 변수 넣기 (2) 답변완료
kimki**** | 2021.09.16 | 추천 0 | 조회 37
kimki**** 2021.09.16 0 37
3958 함수/공식
시트 내 중복되는 문자열이 있을 때 표시할 수 있는 함수나 방법 (6) 답변완료
보조메일 | 2021.09.16 | 추천 0 | 조회 42
보조메일 2021.09.16 0 42
3957 VBA
썸네일 이미지 url 추출 첨부파일 (8)
넘버원 | 2021.09.16 | 추천 0 | 조회 46
넘버원 2021.09.16 0 46
3956 피벗테이블
엑셀 피벗테이블 필터에 대한 질문입니다. 첨부파일 (1)
치킨카뤠 | 2021.09.15 | 추천 0 | 조회 26
치킨카뤠 2021.09.15 0 26