본문 바로가기

카테고리 없음

ㅇㅇㅇ

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