VBA Excel Direct Export sample1 - bami74/me GitHub Wiki

Private Sub Retrieve_Data()
''On Error GoTo ERR1
    Dim strSql As String
    Dim intRow As Long
    Dim intCol As Integer
    Dim i As Integer
    Dim GetTotRow As Long
    Dim lRet As Long
    Dim strSqlXls As String
    Dim bStopRetrieve As Boolean
    
    bStopRetrieve = False
    
    If F1.NumSheets > 1 Then
        F1.DeleteSheets 2, F1.NumSheets - 1
    End If
    
    F1.Sheet = 1
    
    If l_blnRetrieveData = True Then
        MsgBox "기존 조회중입니다. 잠시후 기다렸다가 조회 버튼을 눌러서 조회해주세요.", vbOKOnly, "알림"
        Exit Sub
    End If
    l_blnRetrieveData = True
    ''cmdMenu(l_intCancel).Enabled = True     ' 취소버튼 활성화

    l_intTitleRows = m_ex_lExcelTitleRows
    
    
    If F1.MaxRow > l_intTitleRows Then
        
        DoEvents
        F1.ClearRange l_intTitleRows + 1, 1, F1.MaxRow, F1.MaxCol, F1ClearAll
    
    End If
    
    ''Call g_frmxxx.ShowWaiting(1, 0, "조회를 위한 엑셀 시트(Factor 연동 Sheet) Clear 중 입니다..")
    DoEvents

    If F1.NumSheets > 1 Then
        F1.DeleteSheets 2, F1.NumSheets - 1
    End If
    If F1_1.NumSheets > 1 Then
        F1_1.DeleteSheets 2, F1.NumSheets - 1
    End If
    
    ''Call g_frmxxx.ShowWaiting(1, 0, "조회 준비 중입니다..")
    DoEvents
    
    F1.Row = l_intTitleRows + 1
    F1.Col = 1
    
    
    lblListCount.Caption = ""

    
    Dim strSql_OrderBy As String
    strSql_OrderBy = "  "
    strSql = strSql & strSql_OrderBy
    '----------------------------------------------------------------------------------------------------
    
    
    Dim strSql1 As String
    strSql1 = Replace(strSql, "select /*+rule*/ t.*", "select /*+rule*/ count(*) cnt")
    strSql1 = Replace(strSql1, strSql_OrderBy, "")
    
    '-- 레코드 count를 얻는다. --
    Set g_adoRs = New ADODB.Recordset
    g_adoRs.Open strSql1, g_adoCn
    
    Dim lRecordCount As Long
    lRecordCount = g_adoRs!cnt
    If g_adoRs.State <> adStateClosed Then g_adoRs.Close
        
    '-- 4만건 이하 레코드 목록 조회 한다. --
    If lRecordCount >= 0 And lRecordCount <= 40000 Then
    
        Set g_adoRs = New ADODB.Recordset
        g_adoCn.CursorLocation = adUseServer
        g_adoRs.Open strSql, g_adoCn
        g_adoCn.CursorLocation = adUseClient
        
        F1.MaxCol = m_ex_lExcelTitleCols
        m_ex_lExcelRowEnd = lRecordCount + m_ex_lExcelTitleRows
        
        If g_adoRs.EOF = True Then
            '-- 타이틀, 데이터 폭, 포맷, 정렬 설정 --
            Call exSetWidthHeight(F1)
            
            GoTo NoData
        End If
        
        ''Call g_frmxxx.ShowWaiting(1, 0, "데이터 조회 준비중 입니다..")
        DoEvents
        
        ReDim l_ary_retrieve(lRecordCount, exFindTitleIDX("wc_oc_bt_price"))
        
        ''Call g_frmxxx.ShowWaiting(1, 0, "데이터 조회 중 입니다..")
        DoEvents
        
        Dim rowcnt As Long
        
        '----------------------------------------------------------------------------------------------------
        '--F1에 조회 목록을 뿌려주자.
        '----------------------------------------------------------------------------------------------------
        '-- F1 데이터 첫번째 줄로 이동 --
        m_ex_lRowIndex = m_ex_lExcelRowStart
        
        Dim intViewDbColStart As Integer
        intViewDbColStart = 3
        For rowcnt = 1 To lRecordCount
            
            If (m_ex_lRowIndex - m_ex_lExcelTitleRows) Mod 100 = 0 Or (m_ex_lRowIndex - m_ex_lExcelTitleRows) = (lRecordCount) Then
                g_frmWait.lblcount.Caption = CStr(m_ex_lRowIndex - m_ex_lExcelTitleRows) & " / " & (lRecordCount)
                lblListCount.Caption = "조회목록 : " & g_frmWait.lblcount.Caption
                DoEvents
            End If
            
            If rowcnt >= 40000 Then
                m_ex_lExcelRowEnd = m_ex_lRowIndex
                Exit For
            End If

            If CancelFlag = True Then
                ' 취소를 눌렀으므로, 조회를 종료한다.
                
                If MsgBox("조회를 중단하시겠습니까?", vbQuestion + vbYesNo, "안 내") = vbYes Then
                    
                    bStopRetrieve = True
                    MsgBox "조회중 취소를 선택하였으므로, 조회를 중단합니다.", vbInformation + vbOKOnly, "안 내"
                    
                    Unload g_frmWait
                    CancelFlag = False
                    
                    ''cmdMenu(l_intCancel).Enabled = False
                    
                    GoTo COPY
                Else
                    CancelFlag = False
                End If
                
            End If
            
            '-- 데이터 다음 줄로 이동 --
            m_ex_lRowIndex = m_ex_lRowIndex + 1
            
            '-- 다음 레코드 셋으로 이동 --
            g_adoRs.MoveNext
        Next
        '----------------------------------------------------------------------------------------------------
    
COPY:
        F1.SetSelection l_intTitleRows + 1, 1, l_intTitleRows + lRecordCount, m_ex_lExcelTitleCols
        F1.SetBorder -1, 1, 1, 1, 1, 0, -1, RGB(190, 190, 190), RGB(190, 190, 190), RGB(190, 190, 190), RGB(190, 190, 190)
    
        '-- 타이틀, 데이터 폭, 포맷, 정렬 설정 --
        Call exSetWidthHeight(F1)
        
        '-- Sheet 복사 --
        F1_1.ClearRange 1, 1, F1_1.MaxRow, F1_1.MaxCol, F1ClearAll
        F1_1.CopyAll F1.SS
        F1_1.FixedRows = 3
        '-- Sheet 복사 끝 --
        
    
        F1.SetSelection 1, 1, 1, 1
        
        
        Unload g_frmWait
        F1.Modified = False
        m_ex_bModified = False
        
        l_blnRetrieveData = False
        ''cmdMenu(l_intCancel).Enabled = False
        ReDim UPDATE_PRICE_INFOItem(0)
        
        g_adoCn.CursorLocation = adUseClient
        If g_adoRs.State <> adStateClosed Then g_adoRs.Close
            
        
        
    '-- 4만건 초과 레코드에 대한 처리 분기 --
    Else
    
        Unload g_frmWait
        
        If lRecordCount > 1048500 Then
        
            MsgBox "최대건수가 1,048,500 건을 넘으면 표시할 수 없습니다. ", vbInformation + vbOKOnly, "안 내!"
            GoTo CANCEL_RETRIEVE
        
        End If
        
        If MsgBox(Str(lRecordCount) & "건이 조회되었습니다." & vbCrLf & vbCrLf & "40,000건이 넘으므로, Excel 로 직접 표시합니다." & vbCrLf & vbCrLf & "Excel Export 를 진행하시겠습니까?", vbInformation + vbYesNo, "안 내!") = vbNo Then
        
            GoTo CANCEL_RETRIEVE
        End If
        
        MsgBox "건수가 많으므로, 조회에 시간이 많이 걸릴 수 있습니다." & vbCrLf & vbCrLf & "기다려주시기 바랍니다." & vbCrLf & vbCrLf & " *) 진행중, 개별 Excel작업을 하실 수 있습니다.", vbInformation + vbOKOnly, "안 내!"
    
        '-- 열려는 파일명으로 엑셀이 열려있으면 메세지 출력 후 종료 --
        lRet = gGet_ProgHwnd("xxxtemp.xlsx")
        If lRet <> 0 Then
            
            MsgBox "xxxtemp 파일이 이미 열려 있습니다. 닫은 후에 조회해주세요.", vbCritical, "확인"
            Exit Sub
        End If
    
        GetTotRow = lRecordCount
        ''Call g_frmxxx.ShowWaiting(1, 0, CStr(lRecordCount) & " 건의 데이터를 가져오는 중....")
        
        ''cmdMenu(l_intCancel).Enabled = True     ' 취소버튼 활성화
    
        
        '-- 엑셀 파일에 직접 쓰기 --
        Dim strXlFileName As String
        Dim strConnExcel As String
        Dim adoConnExcel As ADODB.Connection
        
        
        strXlFileName = "c:\xxxtemp.xlsx"
        If Dir(strXlFileName) <> "" Then
            Kill strXlFileName
            DoEvents
        End If
    
        strConnExcel = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\xxxtemp.xlsx;Extended Properties='Excel 12.0 xml;HDR=YES';"
        Set adoConnExcel = CreateObject("ADODB.Connection")
        adoConnExcel.ConnectionString = strConnExcel
        adoConnExcel.CursorLocation = adUseServer
        adoConnExcel.Open
    
        
        
        strSqlXls = "CREATE TABLE Sheet1 ("

        For i = 1 To m_ex_lExcelTitleCols
            If i > 1 Then strSqlXls = strSqlXls & ", "

                '-- Chr(34) : " --
                strSqlXls = strSqlXls & Chr(34) & Left$("(" & i & ")" & exTitleItem(i).sColName, 100) & Chr(34) & "   TEXT "
        
        Next

        strSqlXls = strSqlXls & ")"
        adoConnExcel.Execute strSqlXls
        
        
        
        
        Set g_adoRs = New ADODB.Recordset
        g_adoCn.CursorLocation = adUseServer
        g_adoRs.Open strSql, g_adoCn
        g_adoCn.CursorLocation = adUseClient
        
        F1.MaxCol = m_ex_lExcelTitleCols
        m_ex_lExcelRowEnd = lRecordCount + m_ex_lExcelTitleRows

        ''Call g_frmxxx.ShowWaiting(1, 0, "엑셀로의 데이터 조회 준비중 입니다..")
        DoEvents

        ReDim l_ary_retrieve(lRecordCount, exFindTitleIDX("wc_oc_bt_price"))

        ''Call g_frmxxx.ShowWaiting(1, 0, "엑셀로의 데이터 조회 중 입니다..")
        DoEvents


        '----------------------------------------------------------------------------------------------------
        '--F1에 저장 오류 목록을 뿌려주자.
        '----------------------------------------------------------------------------------------------------
        intViewDbColStart = 3



        For rowcnt = 1 To lRecordCount

            strSqlXls = "INSERT INTO Sheet1 VALUES ("

            For i = 1 To m_ex_lExcelTitleCols
                If i > 1 Then strSqlXls = strSqlXls & ", "
                strSqlXls = strSqlXls & "'" & Replace(NullToBlank(g_adoRs(intViewDbColStart + i - 2).Value), "'", "`") & "'"
            Next

            strSqlXls = strSqlXls & ")"
            adoConnExcel.Execute strSqlXls


            If (rowcnt) Mod 100 = 0 Or (rowcnt) = (lRecordCount) Then
                g_frmWait.lblcount.Caption = CStr(rowcnt) & " / " & (lRecordCount)
                lblListCount.Caption = "조회목록 : " & g_frmWait.lblcount.Caption
                DoEvents
            End If

            If CancelFlag = True Then
                ' 취소를 눌렀으므로, 조회를 종료한다.

                If MsgBox("조회를 중단하시겠습니까?", vbQuestion + vbYesNo, "안 내") = vbYes Then

                    bStopRetrieve = True
                    MsgBox "조회중 취소를 선택하였으므로, 조회를 중단합니다.", vbInformation + vbOKOnly, "안 내"

                    CancelFlag = False

                    ''cmdMenu(l_intCancel).Enabled = False

                    GoTo STOP_RETRIEVE
                Else
                    CancelFlag = False
                End If

            End If

            '-- 다음 레코드 셋으로 이동 --
            g_adoRs.MoveNext
        Next
        '----------------------------------------------------------------------------------------------------

STOP_RETRIEVE:
        
        ''Call g_frmxxx.ShowWaiting(1, 0, "엑셀파일을 여는중....")
        DoEvents

        adoConnExcel.Close
        Set adoConnExcel = Nothing
        
        DoEvents
        Shell "rundll32 url,FileProtocolHandler " & strXlFileName, vbMaximizedFocus

        Unload g_frmWait
        ''cmdMenu(l_intCancel).Enabled = False

        
        MsgBox "Excel로의 Export가 완료되었습니다.", vbOKOnly + vbInformation, "안 내!"

CANCEL_RETRIEVE:
        Unload g_frmWait
        F1.Modified = False
        m_ex_bModified = False

        l_blnRetrieveData = False
        ''cmdMenu(l_intCancel).Enabled = False
        ReDim UPDATE_PRICE_INFOItem(0)

        
        g_adoCn.CursorLocation = adUseClient
        If g_adoRs.State <> adStateClosed Then g_adoRs.Close
        

    End If
    
    Set g_adoRs = Nothing
    Exit Sub
    
NoData:
    F1.ClearRange m_ex_lExcelTitleRows + 1, 1, F1.MaxRow, F1.MaxCol, F1ClearAll
    
    Unload g_frmWait
    
    g_frmxxx.StatusBar.Panels(g_frmxxx.m_StatusIdx).Text = "조회할 데이터가 없습니다"
    
    
    l_blnRetrieveData = False
    
    MsgBox "조회할 데이터가 없습니다. ", vbOKOnly, "확인창"
    
    If g_adoRs.State <> adStateClosed Then g_adoRs.Close
    Set g_adoRs = Nothing
    Exit Sub
    
ERR1:
    Unload g_frmWait
    MsgBox Err.Description, vbOKOnly, "오류"

    
    l_blnRetrieveData = False
    ''cmdMenu(l_intCancel).Enabled = False
    
    g_adoCn.CursorLocation = adUseClient
    
    If g_adoRs.State <> adStateClosed Then g_adoRs.Close
    Set g_adoRs = Nothing

End Sub