Excel) OpenAPI를 이용한 juso.go.kr 도로명주소/지번주소/우편번호 검색

프로그램 설명

juso.go.kr (도로명주소 안내시스템)의 OpenAPI를 활용하여 주소 키워드로부터 도로명주소, 지번주소, 영문 도로명주소, 우편번호 등의 정보를 가져와 엑셀 시트에 표시하는 역할을 수행합니다.

코드는 XML 데이터를 파싱하여 필요한 정보를 추출하고, 추출한 정보를 엑셀 시트에 기록하는 작업을 수행하며 이를 통해 주소 키워드에 대한 상세한 주소 정보와 관련된 데이터를 엑셀에서 확인할 수 있습니다.

추가적으로, 주어진 지번 주소로부터 토지에 대한 표준식별체계로 사용되는 번호인 PNU(Parcel Numbering Unit)를 생성하는 부분도 포함되어 있습니다.

사용시 유의사항

1. 이 매크로는 juso.go.kr의 api key 신청에서 "도로명주소 검색 api" key를 신청 발급받은 후 엑셀 vba코드내 service key를 등록 후 사용 가능합니다.
2. 검색 api 신청 예시
   • api 종류 : 도로명주소 api
   • api 유형 : 검색 api
   • 신청기관 유형 : 민간기관
   • 업체(기관명) : 없음(개인)
   • 시스템명 : 엑셀 주소검색
   • 시스템개요 : 엑셀 vba로 openapi를 활용한 주소 검색 기능 구현
   • url(ip) : http://localhost
   • 서비스망 : 인터넷망
   • 서비스용도 : 운영
3. 발급받은 api key로 vba 코드내 "REPLACE YOUR API KEY" 부분을 교체합니다.(아래 사용전 엑셀설정 참고)
4. 엑셀 시트명 Sheet1의 시트명을 바꾸면 작동하지 않습니다. (다른 시트, 다른 파일에서 매크로 실행시 에러방지 위해 vba코드에서 시트이름 고정했으며 이름변경을 하려면 코드내 이름도 변경을 해야 합니다.)
5. Shee1의 기본폼을 변경 하지마세요.(열 삽입 등)
6. 코드는 엑셀 2010에서 작성되었고, 해당 버전에서 정상적으로 작동합니다. (일반적으로 엑셀의 상위 버전에서도 호환성이 유지될 것입니다.)
7. 코드를 사용함으로써 발생하는 오류나 문제에 대해서는 사용자 본인이 책임을 집니다. 또한, 업데이트된 주소 정보나 정확성에 대한 책임은 juso.go.kr에 있습니다. 사용자는 항상 최신 정보를 확인하고, api를 사용함에 있어서 juso.go.kr의 이용약관과 정책을 준수해야 합니다.
8. 코드를 수정하고 출처를 표시하여 배포하는 것은 자유롭게 가능합니다. 그러나 상업적인 목적으로 이용하는 것은 허용되지 않습니다.

사용전 엑셀설정

엑셀에서 xml데이터를 가져오기 위한 필수 라이브러리인 Microsoft XML을 활성화해야 합니다. 또한 발급받은 api key를 올바르게 교체해야 코드가 정상적으로 작동합니다.

1. 엑셀을 엽니다.(매크로 포함하여 엽니다)
2. "개발도구" 메뉴를 선택하고 "Visual Baic" 메뉴를 클릭합니다.
3. vba에디터에서 "도구" 메뉴를 클릭합니다.
4. "참조"를 선택합니다.
5. "Microsoft XML, v6.0" 을 찾아 선택합니다.
6. "확인" 버튼을 클릭합니다.
7. vba 에디터로 돌아가서 "REPLACE YOUR API KEY" 부분을 발급받은 api 키로 교체합니다. (아래 코드의 19행)
8. vba 에디터를 종료합니다.

사용법(Sheet1에서)

1. B6:B열에 주소 입력(코드내 최대행수를 2000으로 한정했지만 2000행의 기존 값을 삭제한다는 의미지 최대 2000개의 행으로 한정해 구동된다는 의미는 아닙니다. 최대 입력할 수 있는 행은 사용자 pc의 메모리량과 조회되는 결과에 따릅니다.)
2. 다량의 주소입력시 입력범위내(B6:B)에 중간에 빈셀이 있으면 안됩니다. 빈셀의 경우 삭제 후 실행하세요.
3. A6:A열 성명 입력란은 선택사항으로 조회에 아무런 영향이 없습니다. (토지조서 작업 등 인덱스용)
4. A2셀 입력값은 연관된 여러 개의 주소가 검색될 경우 출력할 결과 수입니다. (숫자만 입력합니다) 입력한 그대로 정확한 검색을 원할 경우 1을 입력하고 주소입력시 시도/시군구/읍면동/리/지번을 포함한 정확한 주소를 넣으면 됩니다.
5. A3셀에는 검색하고 싶은 바운다리 지정 가능합니다. 값이 없으면 전국 (예: 대전, 대전 서구...)
6. 실행버튼 눌러 실행합니다.

결과출력

1. 결과 출력전 C6:Q2000까지의 기존 셀의 내용은 실행시 삭제됩니다.
2. B열에 기입한 주소는 D열로 단순복사되며, A2의 설정에 따라 입력한 주소당 연관 조회된 주소가 여러개인 경우 D행에 열을 삽입해 복수의 주소정보 출력합니다.
3. 에러코드가 "0"일 경우라도 실행완료 후 빈셀은 서버에서 조회가 안되는 값입니다.
4. 조회는 기본적으로 정확도 우선으로 결과를 출력하나 입력한 값과 조회결과와 비교해 보세요.(지번주소 입력시 조회된 지번주소가 맞는지 등)
5. 주소입력란에 특정문자 포함시 해당 단어 삭제 조치 후 조회됩니다. 특정문자는 sql 명령어 (SELECT", "INSERT", "DELETE", "UPDATE", "CREATE", "DROP", "EXEC", "UNION", "FETCH", "DECLARE", "TRUNCATE") 및 특수문자( <,>,%,=) 입니다.
6. 공동주택여부 결과값이 1이면 공동주택, 0이면 공동주택x 입니다.

에러코드

• 0 정상
• -999 시스템에러
• E0001 승인되지 않은 KEY 입니다.
• E0002 승인되지 않은 사이트 입니다.
• E0003 정상적인 경로로 접속하시기 바랍니다.
• E0005 검색어가 입력되지 않았습니다.
• E0006 주소를 상세히 입력해 주시기 바랍니다.
• E0008 검색어는 한글자 이상 입력되어야 합니다.
• E0009 검색어는 문자와 숫자 같이 입력되어야 합니다. (숫자만 검색 불가)
• E0010 검색어가 너무 깁니다. (한글40자, 영문,숫자 80자 이하)
• E0011 검색어에 너무 긴 숫자가 포함되어 있습니다. (숫자10자 이하)
• E0012 특수문자+숫자만으로는 검색이 불가능 합니다.
• E0013 SQL 예약어 또는 특수문자( %,=,>,<,[,] )는 검색이 불가능 합니다.
• E0014 개발승인키 기간이 만료되어 서비스를 이용하실 수 없습니다.
• E0015 검색 범위를 초과하였습니다.

테스트사항

• A열에 입력한 주소는 약1300개 까지 테스트 하였으나 최대 입력할 수 있는 주소의 행수는 사용자 pc의 메모리량과 조회되는 결과의 양에 따릅니다.
• 이상현상 발생시 댓글달아주세요.

다운로드

코드

Option Explicit

Private Sub GetDataFromAPI4()

    On Error GoTo ErrorHandler
    
    ' 시트 설정
    Const targetSheetName As String = "Sheet1"
    Dim targetSheet As Worksheet
    Set targetSheet = Worksheets.[_Default](targetSheetName)
    
    ' 활성 시트가 원하는 시트인지 확인하고, 그렇지 않다면 서브를 종료
    If ActiveSheet.Name <> targetSheetName Then
        MsgBox "This code can only be executed on the " & targetSheetName & " sheet.", vbExclamation
        Exit Sub
    End If
    
    ' 서비스키 설정
    Const serviceKey As String = "REPLACE YOUR API KEY"
    
    ' 한 페이지당 결과 수(countPerPage)값 셀 위치 설정
    Dim countPerPageValue As Long
    countPerPageValue = targetSheet.Range("A2").value
    
    ' 주소검색 바운다리 값 셀 위치 설정 (빈 셀일 경우 "전국")
    Dim searchBdry As Range
    Set searchBdry = targetSheet.Range("A3")

    Const MAX_ROWS As Long = 2000    ' 처리할 최대 행 수
    Const START_ROW As Long = 6      ' 데이터 출력 시작 행
    
    ' 검색키(주소)가 있는 B열의 범위 설정 (B5부터 시작)
    Dim searchKeyRange As Range
    Set searchKeyRange = targetSheet.Range("B" & START_ROW & ":B" & targetSheet.Cells.Item(targetSheet.Rows.Count, "B").End(xlUp).Row)
    
    If CheckValues(searchKeyRange) Then
        ' 필요한 변수 및 객체 선언
        Dim startTime As Double
        Dim endTime As Double
        Dim executionTime As Double
        
        Dim searchKeyRangeValue As Variant
        Dim i As Long
        Dim temp As Range
        Dim tempArr() As String
        
        Dim httpRequest As Object
        Dim xDoc As MSXML2.DOMDocument60
        Dim xmlResponse As String
        
        Dim rowOffset As Long
        Dim searchKeySingleValue As String
        Dim encodedKeyword As String
        Dim URL As String
        
        Dim xNode As MSXML2.IXMLDOMNode
        Dim xNodes As MSXML2.IXMLDOMNodeList
        
        Dim totalCount As Long
        Dim errCode As String
        
        Dim rowIndex As Long
        Dim admCd As String
        Dim mtYn As String
        Dim lnbrMnnm As String
        Dim lnbrSlno As String
        Dim pnu As String
        
        Dim outerArr() As Variant
        Dim dataArr() As Variant
        
        ' 시작 시간 기록
        startTime = Timer
        
        ' 셀 값을 지우고 셀 형식을 변경
        targetSheet.Range("C" & START_ROW & ":T" & START_ROW + MAX_ROWS).ClearContents
        targetSheet.Range("C" & START_ROW & ":T" & START_ROW + MAX_ROWS).NumberFormat = "General"
        targetSheet.Range("K" & START_ROW & ":M" & START_ROW + MAX_ROWS).NumberFormat = "@"
        targetSheet.Range("T" & START_ROW & ":T" & START_ROW + MAX_ROWS).NumberFormat = "@"
        
        If IsEmpty(searchBdry) Then
            ' searchKeyRange의 값을 배열로 가져옴
            searchKeyRangeValue = GetRangeValuesToArray(searchKeyRange)
            
        Else
            ' 키워드 조합 (searchBdry + searchKeyRange)
            ReDim tempArr(1 To searchKeyRange.Rows.Count, 1 To 1)
            For Each temp In searchKeyRange
                i = i + 1
                tempArr(i, 1) = searchBdry.value & " " & temp.value
            Next temp
            searchKeyRangeValue = tempArr
            
        End If
        
        ' XMLHTTP 요청을 생성
        Set httpRequest = CreateObject("MSXML2.XMLHTTP")

        ' searchKeyRangeValue의 행 수에 기반하여 outerArr 배열 크기를 조정
        ReDim outerArr(1 To UBound(searchKeyRangeValue, 1))
        
        ' 각 searchKeyRangeValue 각 항목에 대해 반복
        For rowOffset = 1 To UBound(searchKeyRangeValue, 1)
            searchKeySingleValue = searchKeyRangeValue(rowOffset, 1)
            ' 검색할 키워드(주소)값에 sql키워드 및 특수문자를 포함시 제거 후 utf-8로 인코딩
            searchKeySingleValue = rmSQLKeywordsAndSpecialChars(searchKeySingleValue)
            encodedKeyword = encodeURL(searchKeySingleValue)
            
            ' URL 빌드
            URL = "https://business.juso.go.kr/addrlink/addrLinkApi.do?&currentPage=1&firstSort=none&addInfoYn=Y&countPerPage=" & countPerPageValue & "&confmKey=" & serviceKey & "&keyword=" & encodedKeyword
            
            ' GET 요청을 보내고 XML 응답 받기
            httpRequest.Open "GET", URL, False
            httpRequest.send
            xmlResponse = httpRequest.responseText
            
            ' XML 응답을 XML 문서에 로드
            Set xDoc = New MSXML2.DOMDocument60
            xDoc.LoadXML xmlResponse
            
            ' XML 응답을 파싱
            Set xNodes = xDoc.SelectNodes("/results/juso")
            
            ' XML 응답 데이터 갯수, 에러코드 확인
            totalCount = xDoc.SelectSingleNode("/results/common/totalCount").Text
            errCode = xDoc.SelectSingleNode("/results/common/errorCode").Text
        
            ' 빈 배열을 위해 빌드
            If totalCount = 0 Then
                ReDim dataArr(1 To 1, 1 To 16)
                dataArr(1, 1) = errCode
            End If
    
            ' URL XML 응답을 파싱
            If totalCount > 0 Then
                ReDim dataArr(1 To xNodes.Length, 1 To 16)
                rowIndex = 0
                For Each xNode In xNodes
                    rowIndex = rowIndex + 1
                    
                    admCd = xNode.SelectSingleNode("admCd").Text
                    mtYn = xNode.SelectSingleNode("mtYn").Text
                    lnbrMnnm = xNode.SelectSingleNode("lnbrMnnm").Text
                    lnbrSlno = xNode.SelectSingleNode("lnbrSlno").Text
                    pnu = generatePnu(admCd, mtYn, lnbrMnnm, lnbrSlno)
                    
                    dataArr(rowIndex, 1) = errCode
                    dataArr(rowIndex, 2) = xNode.SelectSingleNode("roadAddr").Text
                    dataArr(rowIndex, 3) = xNode.SelectSingleNode("roadAddrPart1").Text
                    dataArr(rowIndex, 4) = xNode.SelectSingleNode("roadAddrPart2").Text
                    dataArr(rowIndex, 5) = xNode.SelectSingleNode("jibunAddr").Text
                    dataArr(rowIndex, 6) = xNode.SelectSingleNode("engAddr").Text
                    dataArr(rowIndex, 7) = xNode.SelectSingleNode("zipNo").Text
                    dataArr(rowIndex, 8) = admCd
                    dataArr(rowIndex, 9) = xNode.SelectSingleNode("rnMgtSn").Text
                    dataArr(rowIndex, 10) = xNode.SelectSingleNode("detBdNmList").Text
                    dataArr(rowIndex, 11) = xNode.SelectSingleNode("bdNm").Text
                    dataArr(rowIndex, 12) = xNode.SelectSingleNode("bdKdcd").Text
                    dataArr(rowIndex, 13) = xNode.SelectSingleNode("hstryYn").Text
                    dataArr(rowIndex, 14) = xNode.SelectSingleNode("relJibun").Text
                    dataArr(rowIndex, 15) = xNode.SelectSingleNode("hemdNm").Text
                    dataArr(rowIndex, 16) = pnu
        
                Next xNode
            End If
            
            ' dataArr를 outerArr에 저장
            outerArr(rowOffset) = dataArr
            
        Next rowOffset
        
        ' searchKeyRange를 열 D로 복사
        targetSheet.Range("D" & START_ROW & ":D" & targetSheet.Cells.Item(targetSheet.Rows.Count, "B").End(xlUp).Row).value = searchKeyRange.value
        
        ' 데이터를 시트에 출력하기 위한 outputRange 설정
        Dim outputRange As Range
        Set outputRange = targetSheet.Range("E" & START_ROW)
        
        
        ' outerArr 배열의 각 항목(innerArr)을 차례로 가져와서 outputRange에 출력
        Dim innerArr() As Variant
        For i = 1 To UBound(outerArr, 1)
            innerArr = outerArr(i)
            ' innerArr 데이터를 outputRange에 출력
            outputRange.Resize(UBound(innerArr, 1), UBound(innerArr, 2)).value = innerArr
            
            ' 삽입된 데이터를 위해 열 D에 행을 삽입
            If UBound(innerArr, 1) > 1 Then
                Dim insertRowRange As Range
                Set insertRowRange = targetSheet.Range("D" & outputRange.Row + 1 & ":D" & outputRange.Row + UBound(innerArr, 1) - 1)
                insertRowRange.Insert Shift:=xlDown
            End If
        
            ' 다음 출력 범위로 이동
            Set outputRange = outputRange.Offset(UBound(innerArr, 1))
        Next i
        
        ' D열에 행번호 추가
        Dim lastRow As Long
        lastRow = targetSheet.Cells.Item(targetSheet.Rows.Count, "D").End(xlUp).Row
        
        Dim rowNumber As Long
        Dim counter As Long
        counter = 1
        For rowNumber = START_ROW To lastRow
            If Not IsEmpty(targetSheet.Cells.Item(rowNumber, "D")) Then
                targetSheet.Cells.Item(rowNumber, "C").value = counter
                counter = counter + 1
            End If
        Next rowNumber
        
        ' 종료 시간 기록
        endTime = Timer
        executionTime = endTime - startTime
        
        ' 완료 메세지 표시
        MsgBox "데이터 조회가 완료되었습니다." & vbCrLf & "총 실행시간 : " & executionTime & "초"
        
        ' 헤더 행을 서식 지정하고 열 너비를 자동 조정
        targetSheet.Range("A" & START_ROW - 1 & ":T" & START_ROW - 1).HorizontalAlignment = xlCenter
        targetSheet.Columns.Item("A:T").AutoFit
    
    Else
        MsgBox "주소 입력셀에 입력값이 없거나 범위내 빈셀이 있습니다."
    
    End If
        
        Exit Sub
    
ErrorHandler:
    MsgBox "오류 발생: " & Err.Description
    
    ' 정리 작업
     Set httpRequest = Nothing
    
    Exit Sub
End Sub

Private Function CheckValues(ByRef rng As Range) As Boolean
    Dim cell As Range
    
    For Each cell In rng
        ' 빈 셀인지 확인
        If IsEmpty(cell) Then
            CheckValues = False
            Exit Function
        End If
    Next cell
    CheckValues = True
End Function

Private Function GetRangeValuesToArray(ByRef rng As Range) As Variant
    ' 범위를 배열로 변환
    Dim values As Variant
    If IsArray(rng.value) Then
        ' 범위가 다차원 배열인 경우
        values = rng.value
    Else
        ' 범위가 단일 셀인 경우
        ReDim values(1 To 1, 1 To 1)
        values(1, 1) = rng.value
    End If
    GetRangeValuesToArray = values
End Function

Private Function rmSQLKeywordsAndSpecialChars(ByRef inputString As String) As String
    ' sql 키워드 및 특수문자 목록
    Dim sqlAndSpecialChars As Variant
    sqlAndSpecialChars = Array("SELECT", "INSERT", "DELETE", "UPDATE", "CREATE", "DROP", "EXEC", "UNION", "FETCH", "DECLARE", "TRUNCATE", "<", ">", "=", "%")
        
    ' 입력 문자열의 복사본 생성
    Dim resultString As String
    resultString = inputString
    
    ' sql 키워드 및 특수문자 제거
    Dim i As Long
    For i = LBound(sqlAndSpecialChars) To UBound(sqlAndSpecialChars)
        resultString = Replace(resultString, sqlAndSpecialChars(i), "", Compare:=vbTextCompare)
    Next i
    
    ' 연속된 여러개의 공백 제거
    Do While InStr(resultString, "  ") > 0
        resultString = Replace(resultString, "  ", " ")
    Loop
    
    ' 선행 및 후행 공백제거
    resultString = Trim$(resultString)
    
    ' 결과 반환
    rmSQLKeywordsAndSpecialChars = resultString
End Function

Private Function encodeURL(ByRef varText As Variant, Optional ByRef blnEncode As Boolean = True) As String
    '**********************************************************************
    ' Function: encodeURL
    ' Description: This function converts a string containing Korean/English
    '              characters and special symbols into a web URL standard address.
    '
    ' Arguments:
    '   - varText: The string to be converted into a standard URL address.
    '   - blnEncode: (Optional) If set to TRUE, the result is returned. If set
    '                to FALSE, the function does nothing.
    '
    ' Returns:
    '   - If blnEncode is TRUE, the function returns the URL-encoded string.
    '   - If blnEncode is FALSE, the function returns an empty string.
    '
    ' Dependencies:
    '   - Requires the "htmlfile" object from Microsoft Internet Controls.
    '     Make sure the "Microsoft HTML Object Library" reference is added
    '     to your VBA project.
    '
    '**********************************************************************
    Static objHtmlfile As Object
    
    ' htmlfile 개체가 존재하지 않는 경우에만 생성
    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        With objHtmlfile.parentWindow
            .execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
        End With
    End If
    
    ' blnEncode가 TRUE인 경우, varText를 JavaScript 함수를 사용하여 인코딩
    If blnEncode Then
        encodeURL = objHtmlfile.parentWindow.encode(varText)
    End If
End Function

Private Function generatePnu(ByRef admCd As String, ByRef mtYn As String, ByRef lnbrMnnm As String, ByRef lnbrSlno As String) As String
    Dim resultString As String
    
    ' mtYn 값을 1은 2로, 0은 1로 변환
    Dim mtYnConverted As String
    If mtYn = 1 Then
        mtYnConverted = 2
    Else
        mtYnConverted = 1
    End If
    
    ' nbrMnnm과 lnbrSlno 값을 "0000" 형식으로 변환하여 저장
    Dim formattedMnnm As String
    Dim formattedSlnm As String
    formattedMnnm = Format$(lnbrMnnm, "0000")
    formattedSlnm = Format$(lnbrSlno, "0000")
    
    ' 결과 문자열을 생성
    resultString = admCd & mtYnConverted & formattedMnnm & formattedSlnm
    
    ' 결과를 반환
    generatePnu = resultString
End Function