Option Explicit
'===========================================
' 메인 실행 함수
'===========================================
Public Sub FetchDataAndCreateSheet()
On Error GoTo ErrorHandler
' 변수 선언
Dim http As Object
Dim url As String
Dim postData As String
Dim response As String
Dim jsonData As Object
Dim wsSettings As Worksheet
Dim wsResult As Worksheet
Dim jsessionid As String
Dim scouter As String
Dim rows As String
Dim page As String
' 설정 시트에서 값 읽기
Set wsSettings = ThisWorkbook.Worksheets("Settings")
url = wsSettings.Range("B1").Value
jsessionid = wsSettings.Range("B2").Value
scouter = wsSettings.Range("B3").Value
rows = wsSettings.Range("B5").Value
page = wsSettings.Range("B6").Value
' POST 데이터 구성
postData = "rows=" & rows & "&page=" & page
' HTTP 객체 생성
Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
' 요청 열기 (POST, URL, 비동기=False)
http.Open "POST", url, False
' 헤더 설정
http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
http.setRequestHeader "Accept", "application/json"
http.setRequestHeader "Cookie", "JSESSIONID=" & jsessionid & "; SCOUTER=" & scouter
' 추가 헤더가 필요하면 여기에 추가
' http.setRequestHeader "X-Custom-Header", "value"
' 요청 전송
http.send postData
' 응답 확인
If http.Status = 200 Then
response = http.responseText
' JSON 파싱
Set jsonData = JsonConverter.ParseJson(response)
' 결과 시트 생성 및 데이터 출력
Set wsResult = CreateResultSheet()
Call WriteJsonToSheet(jsonData, wsResult)
MsgBox "데이터를 성공적으로 가져왔습니다!", vbInformation
Else
MsgBox "HTTP 오류: " & http.Status & " - " & http.statusText, vbCritical
End If
' 정리
Set http = Nothing
Set jsonData = Nothing
Exit Sub
ErrorHandler:
MsgBox "오류 발생: " & Err.Description, vbCritical
Set http = Nothing
End Sub
'===========================================
' 결과 시트 생성 함수
'===========================================
Private Function CreateResultSheet() As Worksheet
Dim ws As Worksheet
Dim sheetName As String
Dim i As Integer
' 시트 이름 (날짜/시간 기반)
sheetName = "Result_" & Format(Now, "yyyymmdd_hhmmss")
' 기존 시트가 있으면 삭제
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(sheetName).Delete
Application.DisplayAlerts = True
On Error GoTo 0
' 새 시트 생성
Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
ws.Name = sheetName
Set CreateResultSheet = ws
End Function
'===========================================
' JSON 데이터를 시트에 쓰는 함수
'===========================================
Private Sub WriteJsonToSheet(jsonData As Variant, ws As Worksheet)
Dim dataArray As Variant
Dim item As Variant
Dim key As Variant
Dim row As Long
Dim col As Long
Dim headerWritten As Boolean
row = 1
headerWritten = False
' JSON 구조에 따라 처리
' 케이스 1: 배열 형태 [{...}, {...}, ...]
If TypeName(jsonData) = "Collection" Then
Set dataArray = jsonData
For Each item In dataArray
col = 1
' 헤더 쓰기 (첫 번째 항목에서만)
If Not headerWritten Then
For Each key In item.Keys
ws.Cells(row, col).Value = key
ws.Cells(row, col).Font.Bold = True
ws.Cells(row, col).Interior.Color = RGB(200, 200, 200)
col = col + 1
Next key
row = row + 1
headerWritten = True
End If
' 데이터 쓰기
col = 1
For Each key In item.Keys
ws.Cells(row, col).Value = GetValueAsString(item(key))
col = col + 1
Next key
row = row + 1
Next item
' 케이스 2: 객체 안에 배열이 있는 경우 {"data": [{...}, {...}], "total": 100}
ElseIf TypeName(jsonData) = "Dictionary" Then
' "data", "rows", "items", "list" 등 일반적인 키 확인
Dim dataKey As String
dataKey = FindDataArrayKey(jsonData)
If dataKey <> "" Then
' 메타 정보 출력 (total, page 등)
ws.Cells(1, 1).Value = "=== 메타 정보 ==="
ws.Cells(1, 1).Font.Bold = True
row = 2
For Each key In jsonData.Keys
If key <> dataKey Then
ws.Cells(row, 1).Value = key
ws.Cells(row, 2).Value = GetValueAsString(jsonData(key))
row = row + 1
End If
Next key
row = row + 1
ws.Cells(row, 1).Value = "=== 데이터 ==="
ws.Cells(row, 1).Font.Bold = True
row = row + 1
' 데이터 배열 처리
Set dataArray = jsonData(dataKey)
headerWritten = False
For Each item In dataArray
col = 1
If Not headerWritten Then
For Each key In item.Keys
ws.Cells(row, col).Value = key
ws.Cells(row, col).Font.Bold = True
ws.Cells(row, col).Interior.Color = RGB(200, 200, 200)
col = col + 1
Next key
row = row + 1
headerWritten = True
End If
col = 1
For Each key In item.Keys
ws.Cells(row, col).Value = GetValueAsString(item(key))
col = col + 1
Next key
row = row + 1
Next item
Else
' 단순 객체인 경우
For Each key In jsonData.Keys
ws.Cells(row, 1).Value = key
ws.Cells(row, 2).Value = GetValueAsString(jsonData(key))
row = row + 1
Next key
End If
End If
' 열 너비 자동 조정
ws.Columns.AutoFit
End Sub
'===========================================
' 데이터 배열 키 찾기
'===========================================
Private Function FindDataArrayKey(jsonDict As Object) As String
Dim key As Variant
Dim commonKeys As Variant
' 일반적으로 사용되는 데이터 배열 키 이름들
commonKeys = Array("data", "rows", "items", "list", "records", "results", "content")
For Each key In jsonDict.Keys
If TypeName(jsonDict(key)) = "Collection" Then
FindDataArrayKey = key
Exit Function
End If
Next key
FindDataArrayKey = ""
End Function
'===========================================
' 값을 문자열로 변환
'===========================================
Private Function GetValueAsString(val As Variant) As String
If IsNull(val) Then
GetValueAsString = ""
ElseIf TypeName(val) = "Dictionary" Or TypeName(val) = "Collection" Then
GetValueAsString = JsonConverter.ConvertToJson(val)
Else
GetValueAsString = CStr(val)
End If
End Function
'===========================================
' 페이징 처리 (여러 페이지 가져오기)
'===========================================
Public Sub FetchAllPages()
Dim http As Object
Dim url As String
Dim postData As String
Dim response As String
Dim jsonData As Object
Dim wsSettings As Worksheet
Dim wsResult As Worksheet
Dim jsessionid As String
Dim scouter As String
Dim rows As Long
Dim currentPage As Long
Dim totalPages As Long
Dim allData As Collection
Set wsSettings = ThisWorkbook.Worksheets("Settings")
Set allData = New Collection
url = wsSettings.Range("B1").Value
jsessionid = wsSettings.Range("B2").Value
scouter = wsSettings.Range("B3").Value
rows = CLng(wsSettings.Range("B5").Value)
Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
currentPage = 1
totalPages = 1 ' 첫 요청 후 업데이트
Do While currentPage <= totalPages
postData = "rows=" & rows & "&page=" & currentPage
http.Open "POST", url, False
http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
http.setRequestHeader "Accept", "application/json"
http.setRequestHeader "Cookie", "JSESSIONID=" & jsessionid & "; SCOUTER=" & scouter
http.send postData
If http.Status = 200 Then
response = http.responseText
Set jsonData = JsonConverter.ParseJson(response)
' 첫 페이지에서 총 페이지 수 계산
If currentPage = 1 Then
If TypeName(jsonData) = "Dictionary" Then
If jsonData.Exists("total") Then
totalPages = Application.WorksheetFunction.Ceiling(jsonData("total") / rows, 1)
End If
End If
End If
' 데이터 수집
Call CollectData(jsonData, allData)
Application.StatusBar = "페이지 " & currentPage & " / " & totalPages & " 처리 중..."
currentPage = currentPage + 1
Else
MsgBox "HTTP 오류 (페이지 " & currentPage & "): " & http.Status, vbCritical
Exit Do
End If
Loop
' 결과 출력
Set wsResult = CreateResultSheet()
Call WriteCollectionToSheet(allData, wsResult)
Application.StatusBar = False
MsgBox "총 " & allData.Count & "건의 데이터를 가져왔습니다!", vbInformation
Set http = Nothing
End Sub
'===========================================
' Collection에서 데이터 수집
'===========================================
Private Sub CollectData(jsonData As Variant, allData As Collection)
Dim dataKey As String
Dim item As Variant
If TypeName(jsonData) = "Collection" Then
For Each item In jsonData
allData.Add item
Next item
ElseIf TypeName(jsonData) = "Dictionary" Then
dataKey = FindDataArrayKey(jsonData)
If dataKey <> "" Then
For Each item In jsonData(dataKey)
allData.Add item
Next item
End If
End If
End Sub
'===========================================
' Collection을 시트에 쓰기
'===========================================
Private Sub WriteCollectionToSheet(dataCollection As Collection, ws As Worksheet)
Dim item As Variant
Dim key As Variant
Dim row As Long
Dim col As Long
Dim headerWritten As Boolean
row = 1
headerWritten = False
For Each item In dataCollection
col = 1
If Not headerWritten Then
For Each key In item.Keys
ws.Cells(row, col).Value = key
ws.Cells(row, col).Font.Bold = True
ws.Cells(row, col).Interior.Color = RGB(200, 200, 200)
col = col + 1
Next key
row = row + 1
headerWritten = True
End If
col = 1
For Each key In item.Keys
ws.Cells(row, col).Value = GetValueAsString(item(key))
col = col + 1
Next key
row = row + 1
Next item
ws.Columns.AutoFit
End Sub카테고리 없음