학습 04) Open API, 엑셀 VBA

XML 파일을 만글고, XML 파일에서  필요한 항목을 표시 하는 프로그램 입니다.

Option Explicit
Sub Open_API01()

    '// 변수 선언
    Dim strURL, FileName, FS_Type As String
    Dim OHTTP As WinHttpRequest
    Set OHTTP = New WinHttpRequest '// WinHttpRequest 객체 생성
    
    Dim objStream, strData As String
    Dim objXML As DOMDocument60
    Set objXML = New DOMDocument60
    
    Dim nodeList As IXMLDOMNodeList
    Dim NodeCell As IXMLDOMNode
    Dim NodeChild As IXMLDOMNode
    Dim i As Integer
      
    '//API URL 설정
    strURL = "https://opendart.fss.or.kr/api/fnlttSinglAcnt.xml?crtfc_key=48542aceeb298dfe12a6383dcd52bd703145664f"
    strURL = strURL & "&corp_code=01168684"
    strURL = strURL & "bsns_year=2019"
    strURL = strURL & "&reprt_code=11011"
    
    '// GET 요청 설정 및 전송
    OHTTP.Open "Get", strURL, False
    OHTTP.Send
    
    '// 상태 코드 및 응답 본문 확인
    '//Debug.Print "Status: " & OHTTP.Status
    '//Debug.Print "ResponseText: " & OHTTP.ResponseText
    '//Debug.Print "ResponseBody length: " & LenB(OHTTP.ResponseBody)
    
    
     If OHTTP.Status = 200 Then '// 응답 처리 (성공 시, 상태 코드 200)
     
            '// 바이너리 파일 저장
            FileName = "G:\Dart\DartTest.xml"
            Open FileName For Binary Access Write As #1
            Put #1, 1, OHTTP.ResponseBody
            Close #1
                       
            '// UTF-8로 인코딩된 텍스트 파일을 읽기
            Set objStream = CreateObject("ADODB.Stream")
            objStream.Charset = "utf-8"
            objStream.Open
            objStream.LoadFromFile (FileName)
            strData = objStream.ReadText()
            
             '// 불필요한 문자 지우기
            strData = Mid(strData, InStr(1, strData, "<?xml"))
            
            objXML.LoadXML (strData)
            Set nodeList = objXML.SelectNodes("result/list")
            
            i = 2
            
            For Each NodeCell In nodeList
                For Each NodeChild In NodeCell.ChildNodes
                    If NodeChild.nodeName = "fs_div" Then
                              FS_Type = NodeChild.Text
                    End If
                    If FS_Type = "CFS" Then
                        If NodeChild.nodeName = "account_nm" Then
                            Range("A" & i).Value2 = NodeChild.Text
                        ElseIf NodeChild.nodeName = "thstrm_nm" Then
                            Range("B" & i).Value2 = NodeChild.Text
                        ElseIf NodeChild.nodeName = "thstrm_dt" Then
                            Range("C" & i).Value2 = NodeChild.Text
                        ElseIf NodeChild.nodeName = "thstrm_amount" Then
                            Range("D" & i).Value2 = NodeChild.Text
                        ElseIf NodeChild.nodeName = "frmtrm_nm" Then
                            Range("E" & i).Value2 = NodeChild.Text
                        ElseIf NodeChild.nodeName = "frmtrm_dt" Then
                            Range("F" & i).Value2 = NodeChild.Text
                        ElseIf NodeChild.nodeName = "frmtrm_amount" Then
                            Range("G" & i).Value2 = NodeChild.Text
                        ElseIf NodeChild.nodeName = "bfefrmtrm_nm" Then
                            Range("H" & i).Value2 = NodeChild.Text
                        ElseIf NodeChild.nodeName = "bfefrmtrm_dt" Then
                            Range("I" & i).Value2 = NodeChild.Text
                        ElseIf NodeChild.nodeName = "bfefrmtrm_amount" Then
                            Range("J" & i).Value2 = NodeChild.Text
                            i = i + 1
                        End If
                    End If
                Next NodeChild
            Next NodeCell
            
     End If
End Sub

 

원본 코드

 

▷ ▷ 참고 자료

For Each 문법

<VBA> For Each문 사용하기

 

UTF-8 파일 읽기 및 쓰기

Read & Write UTF-8 Files

---