실시간 네이버 환율 및 유가 JSON 파싱 예제

관련 답변: 지식인

 

엑셀 연결할 필요 없이

파워포인트에서 직접 해당사이트의 데이터를 크롤링해오도록 했습니다.

​

네어버 finance의 경우 각각의 데이터를 JSON형식으로 서버에서 받아옵니다.

달러 환율 JSON데이터

두바이유 JSON데이터

위와 같은 축약된 형태의 데이터형식이 JSON으로 이 데이터 형식은 서버자료를 가져올 때 주로 사용됩니다.

VBA에서는 JSONConverter 변환 라이브러리를 이용했습니다.

(Dictionary를 사용했기 때문에 도구>참조에서 Microsoft Scripting Runtime 체크 필요함)

​

서버의 데이터를 가져올 때 Set JSON = ParseJson(JSON문자열)로 파싱해서

JSON("속성1")("속성2") 혹은 배열인 경우 JSON(1)("속성1")("속성2")으로 해당 값을 가져올 수 있습니다.

​

Http접속은 XML 라이브러리의 ServerXMLHttp를 이용했습니다.

​

달러 환율/ 두바이유 가격, 최종 거래날짜, 변동폭의 상승,하락에 다른 글자 색상 변경 등을 추가했습니다.

​

화면구성:

전체 코드는 아래와 같습니다.

 

'도구>참조에서 Microsoft Scripting Runtime 체크필요(Dictionary사용)

Option Explicit
Const DebugOn As Boolean = False

Sub updateData()

    Dim pres As Presentation
    Dim http As Object  'New MSXML2.ServerXMLHTTP60
    Dim Json As New Dictionary
    Dim Url$, USD$, Dubai$, DateAt$, Fluc$, FlucRatio$
    
    Set pres = ActivePresentation
    Set http = CreateObject("MSXML2.ServerXMLHttp")
    If http Is Nothing Then Exit Sub
    
    '환율
    Url = "https://api.stock.naver.com/marketindex/majors/part1"
    Set Json = JsonConverter.ParseJson(getResponse(http, Url))
    
    USD = Json("exchange")(2)("closePrice")
    pres.Slides(1).Shapes("USD").TextFrame.TextRange = USD
    
    DateAt = Left(Json("exchange")(2)("localTradedAt"), 10)
    pres.Slides(1).Shapes("Date").TextFrame.TextRange = DateAt
    
    Fluc = Json("exchange")(2)("fluctuations")
    FlucRatio = Json("exchange")(2)("fluctuationsRatio")
    With pres.Slides(1).Shapes("Fluc").TextFrame.TextRange
        If Fluc > 0 Then .Font.Color = rgbRed Else .Font.Color = rgbBlue
        .Text = Fluc & "( " & FlucRatio & "% )"
        If Fluc > 0 Then .Text = "▲ " & .Text Else .Text = "▼ " & .Text
    End With
    
    If DebugOn Then Debug.Print DateAt, USD, Fluc, FlucRatio
    
    '유가
    Url = "https://api.stock.naver.com/marketindex/majors/part2"
    Set Json = JsonConverter.ParseJson(getResponse(http, Url))
   
    Dubai = Json("energy")(5)("closePrice")
    pres.Slides(2).Shapes("Dubai").TextFrame.TextRange = Dubai
    
    DateAt = Left(Json("energy")(5)("localTradedAt"), 10)
    pres.Slides(2).Shapes("Date").TextFrame.TextRange = DateAt
    
    Fluc = Json("energy")(5)("fluctuations")
    FlucRatio = Json("energy")(5)("fluctuationsRatio")
    
    With pres.Slides(2).Shapes("Fluc").TextFrame.TextRange
         If Fluc > 0 Then .Font.Color = rgbRed Else .Font.Color = rgbBlue
        .Text = Fluc & "( " & FlucRatio & "% )"
        If Fluc > 0 Then .Text = "▲ " & .Text Else .Text = "▼ " & .Text
    End With
    
    If DebugOn Then Debug.Print DateAt, Dubai, Fluc, FlucRatio
    
    Set http = Nothing
    
End Sub

Function getResponse(xhttp As Object, sUrl As String) As String

    With xhttp
        .Open "Get", sUrl, False
        .setRequestHeader "User-agent", "Mozilla/5.0"
        '.setRequestHeader "Accept", "application/json"
        .send
         getResponse = .responseText
    End With
    
End Function

Sub OnSlideShowPageChange(SSW As SlideShowWindow)
    
    If SSW.View.Slide.SlideIndex = 1 Then Call updateData
    
End Sub

 

슬라이드는 5초마다 전환되게 하고 슬라이드쇼 설정에서 ESC를 누를 때까지 반복으로 설정되어야 계속 쇼가 반복됩니다.

​

첨부파일 참고하세요.

UpdateJSON1.pptm

0.09MB