'### Refer to XML DOM '### code by Joowon Oh '### 2011.12.26 21:05 '### http://abyul.com/ '### abyul@naver.com Sub naverAPI() '### DOMDocument 형식을 사용하려면, 도구 > 참조에서 '### Microsoft XML 3.0을 참조시켜줘야합니다. Dim XmlDoc As DOMDocument: Dim blnXml As Boolean Dim strFileName As String: strFileName = "abyul.com_XML.xml" Dim strAPIKey As String '### 네이버API를 사용하기 위해서는 개인별로 Key를 받아야합니다. '### 아래 사이트에서 키를 받으세요.. '### https://dev.naver.com/openapi/register strAPIKey = "개인별로받으셔야함다" '### ◀==이 부분에 꼭 개인키를 넣어야 동작합니다!!!! If strAPIKey = "개인별로받으셔야함다" Then MsgBox "네이버에서 개인 API키를 받으셔야합니당.. ㅎㅎ" & vbNewLine & _ "확인 누르시면 해당 사이트로 이동합니당..", vbInformation, "친절한 아별닷컴 주인장 쵝오.." Dim ie As Object, objDoc As Object Set ie = CreateObject("internetexplorer.application") ie.Navigate "https://dev.naver.com/openapi/register" ie.Visible = True Exit Sub End If Dim strPath As String: strPath = "http://openapi.naver.com/search?key=" & strAPIKey & "&query=nexearch&target=rank" strPath = "http://openapi.naver.com/search?key=" & strAPIKey & "&query=movie&target=ranktheme" Dim strTitle As String: strTitle = " XML 파일 불러오기 에라.. abyul.com" Dim strMsg As String: strMsg = strPath & "파일을 불러오다가 에러가 발생했습니다."
Set XmlDoc = CreateObject("Microsoft.XMLDom") blnXml = XmlDoc.Load(strPath) Application.Wait (Now + TimeValue("0:00:1")) Dim shtTarget As Worksheet: Set shtTarget = Sheets.Add Dim rngTarget As Range: Set rngTarget = shtTarget.Range("B4") Dim i As Integer, j As Integer, k As Integer
If blnXml = True Then Range(rngTarget.Offset(-1, 0), rngTarget.Offset(-1, 3)) = Array("No", "Key", "Rank", "Rank") With XmlDoc.ChildNodes(1) For i = 0 To .ChildNodes(0).ChildNodes.Length - 1 'rngTarget.Offset(i, 0) = .ChildNodes(0).ChildNodes(i).nodeName rngTarget.Offset(i, 0) = i + 1 Next i For i = 0 To .ChildNodes.Length - 1 For j = 0 To .ChildNodes(i).ChildNodes.Length - 1 For k = 0 To .ChildNodes(i).ChildNodes(j).ChildNodes.Length - 1 rngTarget.Offset(j, i + 1 + k) = .ChildNodes(i).ChildNodes(j).ChildNodes(k).Text Next k Next j Next i End With Set XmlDoc = Nothing Else MsgBox strMsg & vbCrLf & Err.Number & " : " _ & Err.Description, vbCritical, strTitle End If
난호님..
안녕하세요? ㅎㅎ 답변이 늦어졌네요..
개인적으로 회사 다니랴, 애들 가르치랴, 책 쓰랴, 프로그램 개발하랴.. 좀 바쁜 시간이었습니다.
예전에 샘플로 만들어 봤던 코드를 살짝 수정해서 공유합니다.
첨부파일을 참고하세요..
다운받기 : abyul.com_20120801_naverAPI_XML_Parsing-1.xlsm
코드 보기..
Option Explicit
'### Refer to XML DOM
'### code by Joowon Oh '### 2011.12.26 21:05
'### http://abyul.com/ '### abyul@naver.com
Sub naverAPI()
'### DOMDocument 형식을 사용하려면, 도구 > 참조에서
'### Microsoft XML 3.0을 참조시켜줘야합니다.
Dim XmlDoc As DOMDocument: Dim blnXml As Boolean
Dim strFileName As String: strFileName = "abyul.com_XML.xml"
Dim strAPIKey As String
'### 네이버API를 사용하기 위해서는 개인별로 Key를 받아야합니다.
'### 아래 사이트에서 키를 받으세요..
'### https://dev.naver.com/openapi/register
strAPIKey = "개인별로받으셔야함다" '### ◀==이 부분에 꼭 개인키를 넣어야 동작합니다!!!!
If strAPIKey = "개인별로받으셔야함다" Then
MsgBox "네이버에서 개인 API키를 받으셔야합니당.. ㅎㅎ" & vbNewLine & _
"확인 누르시면 해당 사이트로 이동합니당..", vbInformation, "친절한 아별닷컴 주인장 쵝오.."
Dim ie As Object, objDoc As Object
Set ie = CreateObject("internetexplorer.application")
ie.Navigate "https://dev.naver.com/openapi/register"
ie.Visible = True
Exit Sub
End If
Dim strPath As String: strPath = "http://openapi.naver.com/search?key=" & strAPIKey & "&query=nexearch&target=rank"
strPath = "http://openapi.naver.com/search?key=" & strAPIKey & "&query=movie&target=ranktheme"
Dim strTitle As String: strTitle = " XML 파일 불러오기 에라.. abyul.com"
Dim strMsg As String: strMsg = strPath & "파일을 불러오다가 에러가 발생했습니다."
Set XmlDoc = CreateObject("Microsoft.XMLDom")
blnXml = XmlDoc.Load(strPath)
Application.Wait (Now + TimeValue("0:00:1"))
Dim shtTarget As Worksheet: Set shtTarget = Sheets.Add
Dim rngTarget As Range: Set rngTarget = shtTarget.Range("B4")
Dim i As Integer, j As Integer, k As Integer
If blnXml = True Then
Range(rngTarget.Offset(-1, 0), rngTarget.Offset(-1, 3)) = Array("No", "Key", "Rank", "Rank")
With XmlDoc.ChildNodes(1)
For i = 0 To .ChildNodes(0).ChildNodes.Length - 1
'rngTarget.Offset(i, 0) = .ChildNodes(0).ChildNodes(i).nodeName
rngTarget.Offset(i, 0) = i + 1
Next i
For i = 0 To .ChildNodes.Length - 1
For j = 0 To .ChildNodes(i).ChildNodes.Length - 1
For k = 0 To .ChildNodes(i).ChildNodes(j).ChildNodes.Length - 1
rngTarget.Offset(j, i + 1 + k) = .ChildNodes(i).ChildNodes(j).ChildNodes(k).Text
Next k
Next j
Next i
End With
Set XmlDoc = Nothing
Else
MsgBox strMsg & vbCrLf & Err.Number & " : " _
& Err.Description, vbCritical, strTitle
End If
rngTarget.CurrentRegion.Columns.AutoFit
End Sub