Excel) OpenAPI를 이용한 공공데이터포털 용도별건물정보 조회

프로그램 설명

data.go.kr 서비스가 2024. 1월부터 vworld로 대체됨에 따라 코드 수정하였습니다.

vworld.kr 의 OpenAPI를 활용하여 토지에 대한 표준식별체계로 사용되는 번호인 PNU(Parcel Numbering Unit)로부터 건축물정보를 가져와 엑셀 시트에 표시하는 역할을 수행합니다.

사용법 및 사용시 유의사항

아래글과 같습니다. 아래글 참고하세요.

활용신청URL

https://www.vworld.kr/dtna/dtna_apiSvcFc_s001.do?apiNum=6

다운로드

openapi-건축물정보조회.xlsm
Size: 58KB
Version: v0.4
Published: 2024-01-12

revision

rev1(20240109) : data.go.kr 서비스가 2024. 1월부터 vworld로 대체됨에 따라 코드 변경

코드

Option Explicit

Private Sub GetDataFromAPI2()

    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"
    
    Const MAX_ROWS As Long = 2000    ' 처리할 최대 행 수
    Const START_ROW As Long = 5      ' 데이터 출력 시작 행
    
    ' pnu가 있는 A열의 범위 설정 (A5부터 시작)
    Dim pnuRange As Range
    Set pnuRange = targetSheet.Range("A" & START_ROW & ":A" & Cells.Item(Rows.Count, "A").End(xlUp).Row)
    
    If Not CheckValues(pnuRange) Then
        MsgBox "입력된 범위에 빈셀이 있거나 입력한 pnu값이 형식(숫자 19자리)에 맞지 않습니다."
        Exit Sub
    End If
    
    ' 필요한 변수 및 객체 선언
    Dim startTime As Double
    Dim executionTime As Double
    
    Dim pnuRangeValue As Variant
    
    Dim xDoc As MSXML2.DOMDocument60
    Dim httpRequest As Object
    Dim xmlResponse As String
    
    Dim rowOffset As Long
    Dim pnuSingleValue As String
    Dim URL As String
    
    Dim errNode As MSXML2.IXMLDOMNode
    Dim errCode As String
    Dim xNode As MSXML2.IXMLDOMNode
    Dim xNodes As MSXML2.IXMLDOMNodeList
    
    Dim totalCount As Long
    Dim rowIndex As Long
    Dim nodeNames As Variant
    Dim i As Long
    
    Dim outerArr() As Variant
    Dim dataArr() As Variant
    
    ' 시작 시간 기록
    startTime = Timer
    
    ' 셀 값을 지우고 셀 형식 변경
    targetSheet.Range("B" & START_ROW & ":Z" & START_ROW + MAX_ROWS).ClearContents
    targetSheet.Range("B" & START_ROW & ":Z" & START_ROW + MAX_ROWS).NumberFormat = "General"
    targetSheet.Range("C" & START_ROW & ":C" & START_ROW + MAX_ROWS).NumberFormat = "@"
    targetSheet.Range("F" & START_ROW & ":F" & START_ROW + MAX_ROWS).NumberFormat = "@"
    targetSheet.Range("Z" & START_ROW & ":Z" & START_ROW + MAX_ROWS).NumberFormat = "yyyy-mm-dd"
    
    
    ' pnuRangeValue가 단일 셀인지 확인
    pnuRangeValue = GetRangeValuesToArray(pnuRange)
    
    ' pnuRangeValue의 행 수를 기준으로 dataArr 배열의 크기를 조정
    ReDim outerArr(1 To UBound(pnuRangeValue, 1))
    
    ' 새로운 XMLHTTP 요청을 생성
    Set httpRequest = CreateObject("MSXML2.XMLHTTP")
    
    ' pnuRangeValue의 각 항목에 대해 반복
    For rowOffset = 1 To UBound(pnuRangeValue, 1)
        pnuSingleValue = pnuRangeValue(rowOffset, 1)
        
        ' URL 빌드
        URL = "https://api.vworld.kr/ned/data/getBuildingUse?&numOfRows=100&format=xml&key=" & serviceKey & "&pnu=" & pnuSingleValue
        
        ' GET 요청을 보내고 XML 응답을 받기
        httpRequest.Open "GET", URL, False
        httpRequest.send
        xmlResponse = httpRequest.responseText
        
        ' XML 응답을 XML 문서로 로드
        Set xDoc = New MSXML2.DOMDocument60
        xDoc.LoadXML xmlResponse
                   
        ' 오류를 위한 XML 응답 파싱
        Set errNode = xDoc.SelectSingleNode("/response/resultCode")
        
        If Not errNode Is Nothing Then
            errCode = convErrCode(errNode.Text)
            ReDim dataArr(1 To 1, 1 To 23)
            dataArr(1, 1) = errCode
        Else
            ' XML 응답 파싱
            Set xNodes = xDoc.SelectNodes("/response/fields/field")
            
            ' XML 응답 데이터 갯수 확인
            totalCount = xDoc.SelectSingleNode("/response/totalCount").Text
            
            ' 빈 배열을 위한 작업
            If totalCount = 0 Then
                ReDim dataArr(1 To 1, 1 To 23)
                ' errCode를 0으로 설정
                dataArr(1, 1) = 0
            End If
            
            ' URL XML 응답을 파싱
            If totalCount > 0 Then
                'xNodes.Length를 기반으로 dataArr 배열의 크기를 조정
                ReDim dataArr(1 To xNodes.Length, 1 To 23)
                rowIndex = 0
                ' 각 노드 이름을 배열로 저장
                nodeNames = Array("ldCodeNm", "mnnmSlno", "agbldgSeCodeNm", "buldKndCodeNm", "buldNm", "buldDongNm", "buldMainAtachSeCodeNm", "buldPlotAr", "buldBildngAr", "buldTotar", "measrmtRt", "btlRt", "strctCodeNm", "mainPrposCodeNm", "detailPrposCodeNm", "buldPrposClCodeNm", "buldHg", "groundFloorCo", "undgrndFloorCo", "prmisnDe", "useConfmDe", "lastUpdtDt")
                
                For Each xNode In xNodes
                    rowIndex = rowIndex + 1
                    
                    'errCode를 0으로 설정
                    dataArr(rowIndex, 1) = 0
                    For i = 0 To UBound(nodeNames)
                        If Not xNode.SelectSingleNode(nodeNames(i)) Is Nothing Then
                            dataArr(rowIndex, i + 2) = xNode.SelectSingleNode(nodeNames(i)).Text
                        End If
                    Next i
                Next xNode
            End If
        
        End If
        
        ' outerArr에 dataArr 저장
        outerArr(rowOffset) = dataArr
        
    Next rowOffset
    
    ' pnu 값을 C 열로 복사
    targetSheet.Range("C" & START_ROW & ":C" & targetSheet.Cells.Item(targetSheet.Rows.Count, "A").End(xlUp).Row).Value = pnuRange.Value
    
    ' 데이터를 시트에 출력할 지점 설정
    Dim outputRange As Range
    Set outputRange = targetSheet.Range("D" & START_ROW)
    
    Dim innerArr() As Variant
    Dim insertRowRange As Range
    For i = 1 To UBound(outerArr, 1)
        innerArr = outerArr(i)
        
        ' innerArr 데이터를 outputRange에 출력
        outputRange.Resize(UBound(innerArr, 1), UBound(innerArr, 2)).Value = innerArr
        
        ' 삽입된 데이터를 위해 열 C에 행을 삽입
        If UBound(innerArr, 1) > 1 Then
            Set insertRowRange = targetSheet.Range("C" & outputRange.Row + 1 & ":C" & outputRange.Row + UBound(innerArr, 1) - 1)
            insertRowRange.Insert Shift:=xlDown
        End If
    
        ' 다음 출력 범위로 이동
        Set outputRange = outputRange.Offset(UBound(innerArr, 1))
    Next i
    
    ' B열에 행번호 매기기
    Dim lastRow As Long
    lastRow = targetSheet.Cells.Item(targetSheet.Rows.Count, "C").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, "C")) Then
            targetSheet.Cells.Item(rowNumber, "B").Value = counter
            counter = counter + 1
        End If
    Next rowNumber
    
    ' 종료 시간 기록
    executionTime = Timer - startTime
    
    ' 완료 메세지 표시
    MsgBox "데이터 조회가 완료되었습니다." & vbCrLf & "총 실행시간 : " & executionTime & "초"
    
    ' 헤더 행 포맷 설정 및 열 자동 맞춤
    targetSheet.Range("A" & START_ROW - 1 & ":Z" & START_ROW - 1).HorizontalAlignment = xlCenter
    targetSheet.Columns.Item("A:Z").AutoFit
    
    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
        
        ' 입력된 값이 19자리의 숫자 문자열인지 확인
        If Not IsNumeric(cell.Value) Or Len(cell.Value) <> 19 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 convErrCode(ByRef errorCode As String) As Long
    Select Case errorCode
        Case "URL_TYPE"
            convErrCode = 11
        Case "PARAM_REQUIRED"
            convErrCode = 12
        Case "INVALID_TYPE"
            convErrCode = 13
        Case "INVALID_RANGE"
            convErrCode = 14
        Case "INVALID_KEY"
            convErrCode = 21
        Case "INCORRECT_KEY"
            convErrCode = 22
        Case "UNAVAILABLE_KEY"
            convErrCode = 23
        Case "OVER_REQUEST_LIMIT"
            convErrCode = 24
        Case "SYSTEM_ERROR"
            convErrCode = 31
        Case "UNKNOWN_ERROR"
            convErrCode = 32
        Case Else
            convErrCode = 32
    End Select
End Function

Leave a Comment