Following function exports data from a table or query to MS Excel.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 |
Public Function Export2XL(InitRow As Long, DBAccess As String, DBTable As String) As Long Dim cn As New ADODB.Connection 'Use for the connection string Dim cmd As New ADODB.Command 'Use for the command for the DB Dim rs As New ADODB.Recordset 'Recordset return from the DB Dim MyIndex As Integer 'Used for Index Dim MyFieldCount As Integer 'Store the number of fields or column Dim ApExcel As Object 'To open Excel Dim MyCol As String Dim Response As Integer Set ApExcel = CreateObject("Excel.application") 'Creates an object ApExcel.Visible = False 'This enable you to see the process in Excel ApExcel.Workbooks.Add 'Adds a new book. cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBAccess _ & ";Persist Security Info=False;JET OLEDB:Database Password=" cn.Open Set cmd.ActiveConnection = cn DBTable = Replace(DBTable, "*'", "%'") Set rs = cn.Execute(DBTable) MyFieldCount = rs.Fields.Count 'Fill the first line with the name of the fields For MyIndex = 0 To MyFieldCount - 1 ApExcel.Cells(InitRow, (MyIndex + 1)).Formula = rs.Fields(MyIndex).Name 'Write Title to a Cell ApExcel.Cells(InitRow, (MyIndex + 1)).Font.Bold = True ApExcel.Cells(InitRow, (MyIndex + 1)).interior.colorindex = 36 ApExcel.Cells(InitRow, (MyIndex + 1)).WrapText = True Next 'Draw border on the title line MyCol = Chr((64 + MyIndex)) & InitRow ApExcel.Range("A" & InitRow & ":" & MyCol).Borders.Color = RGB(0, 0, 0) MyRecordCount = 1 + InitRow 'Fill the excel book with the values from the database Do While rs.EOF = False For MyIndex = 1 To MyFieldCount ApExcel.Cells(MyRecordCount, MyIndex).Formula = rs((MyIndex - 1)).Value 'Write Value to a Cell ApExcel.Cells(MyRecordCount, MyIndex).WrapText = False 'Format the Cell Next MyRecordCount = MyRecordCount + 1 rs.MoveNext Loop ApExcel.Visible = True rs.Close 'Return the last position in the workbook Export2XL = MyRecordCount End Function |