Cari Blog Ini

29 November 2013

How To Export Data From SQL To Microsoft Excel with Display in Many Worksheet

Apply To :
* Microsoft Visual Basic 6
* Microsoft SQL Server 2000
* Microsoft Excel 2010

Problem :

1. Want to export data from SQL Server query to Microsoft Excel
2. There is an maximum row of Microsoft Excel, then want to display to another worksheet







Solution :

1. Example Table :



2. Go to menu "Project > References ... "





3. Go to menu "Project > Components ... "





4. Design an Example Form below




5. Copy the below code to "Form1.frm"



'--------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------
'----START CODE

Private Sub Command1_Click()
    Show_To_Excel
End Sub



Private Function RoundUp(ByVal lngNumber As Long) As Long

    Dim lngTemp As Long
    If Int(lngNumber) <> lngNumber Then
    RoundUp = Int(lngNumber) + 1
    Else
        RoundUp = lngNumber
    End If

End Function


Private Sub Show_To_Excel()


    '---------------------------------------------------------------------
    '---------------------------------------------------------------------
    
    '---Declare for Microsoft Excel
    Dim ExcelApp As Excel.Application
    Dim ExcelWorkBook As Excel.Workbook
    Dim ExcelWorkSheet As Excel.Worksheet
    Dim ExcelRange As Excel.Range
    
    
    '---Declare for Connection
    Dim conn_1 As ADODB.Connection
    Dim rs_1 As ADODB.Recordset
    Dim sql_1 As String
    
    
    '---Declare for DAO - Microsoft Excel
    Dim dbExcel As Database
    Dim rsExcel As DAO.Recordset
    Dim RowNo As Long
    Dim ColNo As Integer
    Dim LineNo As Long
    Dim counterBar As Integer
    Dim i As Integer
        
    
    Dim WorkSheetNum As Long
    Dim MaxExcelRows As Long
    Dim TotalWorkSheet As Long
    MaxExcelRows = 20
    
    Dim fName As Variant
    '---------------------------------------------------------------------
    '---------------------------------------------------------------------
    
    '---Creating Connection
    Set conn_1 = New ADODB.Connection
    conn_1.Open "Provider=sqloledb;Data Source=(local);Initial Catalog=Northwind; User Id=sa; Password=sasasa;"

    '---Creating New File Excel
    Set ExcelApp = New Excel.Application
    fName = ExcelApp.GetSaveAsFilename(, "Excel (*.xls), *.xls", , "Save to Excel")
    If fName = False Then Exit Sub

   
    '---Creating Query
    Set rs_1 = New ADODB.Recordset
    sql_1 = " select * from Products order by ProductID "
    rs_1.Open sql_1, conn_1, 1, 1
        
        
        ProgressBar.Max = rs_1.RecordCount + 1
        counterBar = 0
        
    '---------------------------------------------------------------------
    '---------------------------------------------------------------------
    '---------------------------------------------------------------------
           
    If Not rs_1.EOF Then
                
                counterBar = counterBar + 1
                ProgressBar.Value = counterBar
                
                Dim FieldsType2() As ADODB.DataTypeEnum
                Dim FieldsCount2 As Integer
                Dim TotalRows As Long
                FieldsCount2 = rs_1.Fields.Count
                
        
                ReDim FieldsType2(FieldsCount2 - 1)
                For i = 0 To FieldsCount2 - 1
                    FieldsType2(i) = rs_1.Fields(i).Type
                Next i
                
                
                '---Preparing the worksheet
                Set ExcelWorkBook = ExcelApp.Workbooks.Add
                ExcelWorkBook.SaveAs fName, xlExcel8
                
                TotalWorkSheet = RoundUp(rs_1.RecordCount / MaxExcelRows)
                WorkSheetNum = 1
                TotalRows = rs_1.RecordCount
                
                
                '---Start A - Initialize for Heading Column
                Do While WorkSheetNum <= TotalWorkSheet
                         Set ExcelWorkSheet = ExcelWorkBook.Worksheets.Add
                         ExcelWorkSheet.Name = "Page_" & Format(TotalWorkSheet - WorkSheetNum + 1, "##0")
                         RowNo = 1
                         ColNo = 1
                         ExcelWorkSheet.Cells(RowNo, ColNo).ColumnWidth = Len("Number")
                         ExcelWorkSheet.Cells(RowNo, ColNo) = "No"
                         ExcelWorkSheet.Cells(RowNo, ColNo).HorizontalAlignment = xlLeft
                         ExcelWorkSheet.Cells(RowNo + 1, ColNo) = ""
                         For i = 0 To FieldsCount2 - 1
                             ColNo = ColNo + 1
                             ExcelWorkSheet.Cells(RowNo, ColNo).ColumnWidth = IIf(Len(rs_1.Fields(i).Name) > 15, Len(rs_1.Fields(i).Name), 15)
                             ExcelWorkSheet.Cells(RowNo, ColNo) = CStr(rs_1.Fields(i).Name)
                             If FieldsType2(i) = adDouble Or FieldsType2(i) = adSingle Then
                                 ExcelWorkSheet.Cells(RowNo, ColNo).HorizontalAlignment = xlRight
                                 ExcelWorkSheet.Cells(RowNo, ColNo).NumberFormat = "#, ##0.00;[Red](#, ##0.00);0.00"
                                 ExcelWorkSheet.Cells(RowNo + 1, ColNo) = 0
                             ElseIf FieldsType2(i) = adVarChar Or FieldsType2(i) = adVarWChar Then
                                 ExcelWorkSheet.Cells(RowNo, ColNo).HorizontalAlignment = xlLeft
                                 ExcelWorkSheet.Cells(RowNo + 1, ColNo) = ""
                             ElseIf FieldsType2(i) = adDate Or FieldsType2(i) = adDBDate Or FieldsType2(i) = adDBTimeStamp Then
                                 ExcelWorkSheet.Cells(RowNo, ColNo).HorizontalAlignment = xlLeft
                                 ExcelWorkSheet.Cells(RowNo + 1, ColNo) = Date
                             Else
                                 ExcelWorkSheet.Cells(RowNo, ColNo).HorizontalAlignment = xlRight
                                 ExcelWorkSheet.Cells(RowNo, ColNo).NumberFormat = "###0;[Red](###0);0"
                                 ExcelWorkSheet.Cells(RowNo + 1, ColNo) = 0
                             End If
                         Next i
                         WorkSheetNum = WorkSheetNum + 1
                Loop
                '---End A - Initialize for Heading Column
                ExcelWorkBook.Save
                ExcelWorkBook.Close True
                ExcelApp.Quit
        
                MsgBox "Generating Heading Column Successfully...."
        
        '-----------------------------------------------------------------
        '-----------------------------------------------------------------
            '---Start B. Generating the detail of data To File Excel
            
                Set dbExcel = DBEngine.OpenDatabase(fName, True, False, "Excel 8.0;")
                WorkSheetNum = 1
                '---start Loop - 2
                Do While Not rs_1.EOF
                    Set rsExcel = dbExcel.OpenRecordset(dbExcel.TableDefs(WorkSheetNum - 1).Name)
                    LineNo = 0
                    RowNo = 0
                        '---start Loop - 1
                        Do While Not rs_1.EOF
                        
                            counterBar = counterBar + 1
                            ProgressBar.Value = counterBar
                            
                            LineNo = LineNo + 1
                            RowNo = RowNo + 1
                            If LineNo = 1 Then
                                rsExcel.Edit
                            Else
                                rsExcel.AddNew
                            End If
                            For i = 0 To FieldsCount2 - 1
                                If FieldsType2(i) = adDouble Or FieldsType2(i) = adSingle Then
                                    rsExcel.Fields(i + 1) = Val(rs_1.Fields(i))
                                ElseIf FieldsType2(i) = adVarChar Or FieldsType2(i) = adVarWChar Then
                                    rsExcel.Fields(i + 1) = Mid(CStr(rs_1.Fields(i)), 1, 255)
                                ElseIf FieldsType2(i) = adDate Or FieldsType2(i) = adDBDate Or FieldsType2(i) = adDBTimeStamp Then
                                    If IsDate(rs_1.Fields(i)) Then
                                        rsExcel.Fields(i + 1) = CDate(rs_1.Fields(i))
                                    Else
                                        rsExcel.Fields(i + 1) = Null
                                    End If
                                Else
                                    rsExcel.Fields(i + 1) = Val(rs_1.Fields(i))
                                End If
                            Next
                            rsExcel.Fields("No") = LineNo
                            rsExcel.Update
                
                            '---For progress generating of which Rows
                            Form1.lblProgress.Caption = "Total Rows = " & TotalRows & " - Progress from Row " & RowNo & " of Worksheet " & WorkSheetNum & " ( Total Worksheets = " & TotalWorkSheet & " ) "
                            Form1.lblProgress.Refresh
                            rs_1.MoveNext
                            If rs_1.EOF Or RowNo = MaxExcelRows Then Exit Do
                        Loop
                        '---end Loop - 1
                    rsExcel.Close
                    WorkSheetNum = WorkSheetNum + 1
                Loop
                '---end Loop - 2
                dbExcel.Close
            
            '---End B. Generating the detail of data To File Excel
        '-----------------------------------------------------------------
        '-----------------------------------------------------------------
                MsgBox "Generating Detail To Excel Successfully...."
        
    End If
    '---------------------------------------------------------------------
    '---------------------------------------------------------------------
    '---------------------------------------------------------------------
    
    
    
     Set ExcelWorkBook = ExcelApp.Workbooks.Open(fName)
     ExcelWorkBook.Activate
     MsgBox "Done. Click OK, to Preview..."
     ExcelApp.Visible = True
     

    rs_1.Close
    Set rs_1 = Nothing
    Set conn_1 = Nothing
    
End Sub


Private Sub Form_Load()

End Sub


'----END CODE
'--------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------


A.



B.


C.


D.



E.


F.


G.


H.


I.





6. Try to run the code, click "F5" or "Start". Next, click "Show To Excel"

A.


B.


C.


D.


E.



7. Then, the results will display in Microsoft Excel successfully.
Example :
Total Rows = 77
Maximum Row Per Sheet = 20
So, the Total Worksheet is 4.

A.

B.


C.






To download the Example Project, please click the link below :
Example Code - Export To Excel - Many WorkSheet.rar