Excel VBA Dart 공시 원본 문서 다운로드시 CopyHere Unzip 압축 해제 문제 해결

Excel VBA CopyHere Unzip 압축 해제 문제 해결

아래의 VBA 코드에서 공시 문서를 API 키를 사용해 다운로드하고 압축 해제하는 과정에서 발생한 주요 문제점은 CopyHere 메소드가 제대로 작동하지 않았던 것입니다. 이 문제의 원인은 unzipFolder, zipFile, targetFolder 변수들을 Variant 타입으로 선언하지 않았기 때문입니다.
이 변수들은 Shell 객체의 Namespace 메소드와 함께 작동할 때 반드시 Variant 타입으로 지정되어야 합니다.
이러한 변경을 적용하면, 코드는 문제 없이 압축 파일을 해제할 수 있습니다.

아래는 최종 공시 원본 문서를 다운로드하는 내용입니다.

Sub DownloadDisclosureDocument()
     ' 공시 문서를 다운로드하고 압축을 해제
    Dim api_key As String
    Dim rcept_no As String
    Dim requestURL As String
    Dim WinHttpReq As Object
    Dim downloadPath As String
    Dim stream As Object
    Dim shell As Object
    Dim unzipFolder As Variant
    Dim unzipFolder2 As String

    ' 설정: API 키, 접수 번호 및 다운로드 경로
    api_key = "your_api_key"
    rcept_no = "20190401004781"
    downloadPath = "C:\down\test\"
    unzipFolder = downloadPath & rcept_no & "\"
    unzipFolder2 = unzipFolder

   ' 요청 URL 구성
    requestURL = "https://opendart.fss.or.kr/api/document.xml?crtfc_key=" & api_key & "&rcept_no=" & rcept_no

    ' HTTP 요청 전송 및 응답 처리
    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", requestURL, False
    WinHttpReq.Send

    ' 파일 다운로드 및 압축 해제
    If WinHttpReq.Status = 200 Then
        ' Stream 객체로 파일 다운로드
        Set stream = CreateObject("ADODB.Stream")
        stream.Open
        stream.Type = 1 ' 이진 형식
        stream.Write WinHttpReq.ResponseBody
        stream.SaveToFile downloadPath & rcept_no & ".zip", 2 ' 덮어쓰기 모드
        stream.Close

        ' 폴더가 없으면 생성
        If Not FolderExists(unzipFolder2) Then MkDir unzipFolder2

        ' Shell 객체 생성 및 압축 해제
        Set shell = CreateObject("Shell.Application")
        If Not shell Is Nothing Then
            Dim zipFile, targetFolder As Variant
            Set zipFile = shell.Namespace(downloadPath & rcept_no & ".zip")
            Set targetFolder = shell.Namespace(unzipFolder)
            If Not zipFile Is Nothing And Not targetFolder Is Nothing Then
                targetFolder.CopyHere zipFile.Items
            Else
                Debug.Print "압축 해제 폴더 또는 zip 파일을 찾을 수 없습니다."
            End If
        End If

        Debug.Print "파일 다운로드 및 압축 해제 완료: " & unzipFolder
    Else
        Debug.Print "오류: " & WinHttpReq.Status & " - " & WinHttpReq.statusText
    End If
End Sub

Function FolderExists(path As String) As Boolean
      ' 지정된 경로에 폴더가 존재하는지 확인하는 함수
    FolderExists = Dir(path, vbDirectory) <> ""
End Function