VB(A)

도로명주소 가져오기

당근쨈 2018. 2. 13. 15:19

주소가 중구난방이거나 정식 도로명주소 등이 필요할 때 유용한 함수를 만들었다.

juso.go.kr에서 파싱해오는 방식임


Option Explicit
Function ConvertAddress(MyText As String, Optional WhichAddress As Integer) As String
 
    'Dim oHtml As New HTMLDocument
    Dim oHtml As Object
    Dim myURL As String, postData As String
    Dim winHttpReq As Object
    Dim tmp As String
    
    myURL = "http://www.juso.go.kr/support/AddressMainSearch.do?searchType=TOTAL"   '주소 변환 사이트
    'postData = "searchKeyword=" & WorksheetFunction.EncodeURL(MyText)   '검색어(EncodeURL 은 2013 이상에서 사용 가능)
    postData = "searchKeyword=" & ENDECODingURL(MyText)
    
    Set oHtml = CreateObject("htmlfile")
    Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    With winHttpReq '검색어로 웹소스 가져오기
        .Open "POST", myURL, False
        .SetRequestHeader "Content-Type""application/x-www-form-urlencoded"
        .Send (postData)
        oHtml.body.innerHTML = .responseText
    End With
    
    Set winHttpReq = Nothing
    
    Select Case WhichAddress
        Case 2: tmp = oHtml.getElementById("lndnAddr1").Value    '2일 때 구주소
        Case Else: tmp = oHtml.getElementById("rnAddr1").Value   '나머지는 신주소
    End Select
    
    tmp = Replace(tmp, "<b>""")
    tmp = Replace(tmp, "</b>""")
    ConvertAddress = tmp
    
End Function
 
Function ENDECODingURL(varText As String, 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"
        .execScript "function decode(s) {return decodeURIComponent(s)}""jscript"
      End With
      
    End If
    
    If blnEncode Then
      ENDECODingURL = objHtmlfile.parentWindow.encode(varText)
      
    Else
      ENDECODingURL = objHtmlfile.parentWindow.decode(varText)
    End If
    
End Function
 
cs



통합 문서1 (자동 저장됨).xlsm