Access to Excel

[chrisguk]

I'm exporting data from Access to Excel using "DoCmd.OutputTo" and it works fine. However, I need the data formatted in Excel and would like to know if there is another way to export into Excel using a custom template. Or a way to automate formatting of the excel spreadsheet.

 

[Tidy]

When ever I export data from access to excel I use "CopyFromRecordset". I use this method so I can run query and import only the data I need. The code would look like this

    Dim dbs As Variant
    
    Dim objExcel As Excel.Application
    Dim objxlBook As Excel.Workbook
    Dim objxlSheet As Excel.Worksheet
    Dim objxlPivot As Excel.PivotTable
    
    
    Dim strSQL_ConusEquip As String
    Dim strQuery_ConusEquip As String
    Dim qryDef_ConusEquip As QueryDef
    Dim rst_ConusEquip As DAO.Recordset
 
        'Name Temp Query String
        strQuery_ConusEquip = "Temp_xlConusEquip"
    
        'Create SQL Text For Query
        strSQL_ConusEquip = "SELECT [Status Of Funds FY 10: Combined].Sag, [Status Of Funds FY 10: Combined].Bag, " & _
                             "Sum([Status Of Funds FY 10: Combined].[Distributed Authority]), " & _
                             "Sum([Status Of Funds FY 10: Combined].Obligated), " & _
                             "Sum([obligated])/Sum([Distributed Authority]), " & _
                             "Sum([Status Of Funds FY 10: Combined].Unobligated), " & _
                             "Sum([Unobligated])+Sum([Obligated]), " & _
                             "(Sum([Unobligated])+Sum([Obligated]))/Sum([Distributed Authority]), " & _
                             "Sum([Distributed Authority])-(Sum([Unobligated])+Sum([Obligated]))" & _
                     "FROM [Status Of Funds FY 10: Combined]" & _
                     "GROUP BY [Status Of Funds FY 10: Combined].Sag, [Status Of Funds FY 10: Combined].Bag, " & _
                              "[Status Of Funds FY 10: Combined].[Funds Type]" & _
                     "HAVING ((([Status Of Funds FY 10: Combined].[Funds Type])" & "='Conus'" & ")) " & _
                             "AND ((([Status Of Funds FY 10: Combined].[Sag])" & "='Equip'" & ")) " & _
                             "AND ((([Status Of Funds FY 10: Combined].[Bag])" & "<>'RA'" & "));"
        
        'Create Query
        Set qryDef_ConusEquip = dbs.CreateQueryDef(strQuery_ConusEquip, strSQL_ConusEquip)
                            
        'Open the Recordset
        Set rst_ConusEquip = dbs.QueryDefs(strQuery_ConusEquip).OpenRecordset
                 
            
            'Copy data from QueryDef into Excel
            With objxlSheet
                .Range("B4").CopyFromRecordset rst_ConusEquip

That is an example of how I used the "CopyFromRecordset" to import data into excel.

 

[JohnLee]

Hi,

I export data to Excel and format the spreadsheet on a regular basis, below is an example of how I do this, this was achieved with help from the experts in this forum, so you could also do a search and find more information on how to do this. I also attached my spreadsheet to an email in outlook and this is also shown in my code example below, of which I hope will help you:

[COLOR=blue]Function[/COLOR] ExportCameraToExcel()
[COLOR=blue]On Error Resume Next[/COLOR]
DoCmd.Echo [COLOR=blue]False[/COLOR], "Running Program"   [COLOR=darkgreen]'Indicates in the progress bar the program is running[/COLOR]
DoCmd.Hourglass [COLOR=blue]True[/COLOR]                 [COLOR=darkgreen]'Turn on the Hourglass[/COLOR]
DoCmd.SetWarnings [COLOR=blue]False[/COLOR]            [COLOR=darkgreen]'Turn off warnings[/COLOR]
[COLOR=blue]Dim[/COLOR] ExcelFile [COLOR=blue]As[/COLOR] String                [COLOR=darkgreen]'Declare the ExcelFile variable[/COLOR]
[COLOR=blue]Dim[/COLOR] ExcelWorksheet [COLOR=blue]As[/COLOR] String      [COLOR=darkgreen]'Declare the ExcelWorksheet variable[/COLOR]
[COLOR=blue]Dim[/COLOR] Ques [COLOR=blue]As[/COLOR] String                    [COLOR=darkgreen]'Declare the FEDB varia[/COLOR]ble
[COLOR=blue]Dim[/COLOR] QueryName [COLOR=blue]As[/COLOR] String            [COLOR=darkgreen]'Declare the QueryName variable[/COLOR]
[COLOR=blue]Dim[/COLOR] objDB [COLOR=blue]As[/COLOR] Database               [COLOR=darkgreen]'Declare the objDB variable[/COLOR]
[COLOR=blue]Dim[/COLOR] MyDate                              [COLOR=darkgreen]'Declare the MyDate var[/COLOR]iable
MyDate = Now()                        [COLOR=darkgreen]'Assign the current date[/COLOR]
    [COLOR=darkgreen]'Assign the location to export the Camera Questionnaire excel file to and give the current date[/COLOR]
    ExcelFile = "M:\Customer Satisfaction\Camera\CameraSpreadsheets\cam1s0s" & "_" & Format(MyDate, "ddmmyy") & ".xls"
    ExcelWorksheet = "cam1s0s " & Format(MyDate, "ddmmyy") [COLOR=darkgreen]'Assign cam1s0s as the name of the worksheet in the excel file[/COLOR]
    Ques = "G:\eFlowStatsFrontEnd.mdb" [COLOR=darkgreen]'Assign the name and path of the database to export the table from[/COLOR]
    QueryName = "qryCameraQtrAnalysis"  [COLOR=darkgreen]'Assign the name of the table to be exported to the Excel file[/COLOR]
 
    [COLOR=blue]Set[/COLOR] objDB = OpenDatabase(Ques)  [COLOR=darkgreen]'Set the objDB to open the target database[/COLOR]
    [COLOR=blue]If[/COLOR] Dir(ExcelFile) <> "" [COLOR=blue]Then[/COLOR] Kill ExcelFile [COLOR=darkgreen]'If the Excel file already exists, you can delete it here[/COLOR]
    'Excute the creation of the Excel file
    objDB.Execute "Select*Into[Excel 8.0;Database=" & ExcelFile & "].[" & ExcelWorksheet & "] From " & "[" & QueryName & "]"
    objDB.Close         [COLOR=darkgreen]'Close the database[/COLOR]
    [COLOR=blue]Set[/COLOR] objDB = [COLOR=blue]Nothing[/COLOR] [COLOR=darkgreen]'Set the objDB to nothing[/COLOR]
 
    [COLOR=blue]Dim[/COLOR] ObjExcel [COLOR=blue]As[/COLOR] Object  [COLOR=darkgreen]'Declare the Excel Object[/COLOR]
    [COLOR=blue]Set[/COLOR] ObjExcel = CreateObject("Excel.Application")  [COLOR=darkgreen]'Create an instance of Excel[/COLOR]
    ObjExcel.Visible = [COLOR=blue]True[/COLOR]  [COLOR=darkgreen]'Make Excel visible[/COLOR]
    [COLOR=darkgreen]'Open the Excel workbook cam1s0s with the current date[/COLOR]
    ObjExcel.Workbooks.Open "M:\Customer Satisfaction\Camera\CameraSpreadsheets\cam1s0s" & "_" & Format(MyDate, "ddmmyy") & ".xls"
 
    [COLOR=blue]Set[/COLOR] objsheet = ObjExcel.ActiveWorkbook.Worksheets(1)  [COLOR=darkgreen]'Set the objsheet to active worksheet in the active workbook[/COLOR]
    [COLOR=blue]With[/COLOR] objsheet  [COLOR=darkgreen]'With the active worksheet[/COLOR]
        .Rows("1:1").Font.Bold = True  [COLOR=darkgreen]'Set the first row font to bold[/COLOR]
        .Rows("1:1").Font.Underline = xlUnderlineStyleSingle [COLOR=darkgreen]'Underline the text in each cell of the first row[/COLOR]
        .Rows("1:1").Select [COLOR=darkgreen]'Insert a new row[/COLOR]
        ObjExcel.Selection.Insert Shift:=xlDown
            ObjExcel.Range("A1").Select  [COLOR=darkgreen]'Select Cell A1[/COLOR]
            ObjExcel.ActiveCell.FormulaR1C1 = "Camera Form Code 03_Q"   [COLOR=darkgreen]'Assign the text "Camera Form Code 03_Q" to this cell[/COLOR]
            ObjExcel.Range("B1").Select  [COLOR=darkgreen]'Select Cell B1[/COLOR]
            ObjExcel.ActiveCell.FormulaR1C1 = "As At Date :" [COLOR=darkgreen]'Assign the text "Date:" to this cell[/COLOR]
            ObjExcel.Range("D1").Select  [COLOR=darkgreen]'Select Cell D1[/COLOR]
        ObjExcel.Selection.NumberFormat = "@"   [COLOR=darkgreen]'Set Cell D1 format to text[/COLOR]
        [COLOR=blue]With[/COLOR] ObjExcel.Selection
            .HorizontalAlignment = xlLeft   'Left align the text
            .VerticalAlignment = xlBottom   [COLOR=darkgreen]'Bottom align the text[/COLOR]
            .ReadingOrder = xlContext
        [COLOR=blue]End With[/COLOR]
            ObjExcel.ActiveCell.FormulaR1C1 = Format(MyDate, "ddmmyy")       [COLOR=darkgreen]'Assign the current date[/COLOR]
            .Columns("A:BG").Select                      [COLOR=darkgreen]'Select Columns A to BG[/COLOR]
            .Columns("A:BG").EntireColumn.AutoFit [COLOR=darkgreen]'Autofit the columns to their contents[/COLOR]
            .Columns("A:BG").HorizontalAlignment = xlCenter [COLOR=darkgreen]'Centre the data in each cell Horisontally[/COLOR]
            .Columns("A:BG").VerticalAlignment = xlCenter   [COLOR=darkgreen]'Centre the data in each cell Vertically[/COLOR]
 
        [COLOR=blue]Dim[/COLOR] LastRow [COLOR=blue]As[/COLOR] Long [COLOR=darkgreen]'Declare the LastRow variable as Long[/COLOR]
 
        LastRow = objsheet.Range("A65536").End(xlUp).Row    [COLOR=darkgreen]'Get the last row in each column with no data in it[/COLOR]
 
        [COLOR=blue]With[/COLOR] objsheet.Range("A" & LastRow + 1 & ":BG" & LastRow + 1)
            [COLOR=darkgreen]'Set the formulae to Sum up all the data in the each Column[/COLOR]
            .FormulaR1C1 = "=SUM(R[-" & LastRow & "]C:R[-1]C)"
            [COLOR=darkgreen]'Create borders for all the columns and rows with data in them[/COLOR]
            [COLOR=blue]With[/COLOR] objsheet.Range("A3:BG" & LastRow + 1).Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
            [COLOR=blue]End With[/COLOR]
[COLOR=blue]     End With[/COLOR]
        .Range("A" & LastRow + 1 & ":BG" & LastRow + 1).Font.ColorIndex = 3     [COLOR=darkgreen]'Set the font in the Last Row of Column A to the colour Red[/COLOR]
        .Range("A" & LastRow + 1 & ":BG" & LastRow + 1).Font.Bold = [COLOR=blue]True[/COLOR]        [COLOR=darkgreen]'Set the font in the Last Row of Column A to Bold[/COLOR]
        With objsheet.Range("A" & LastRow + 1 & ":BG" & LastRow + 1).Borders    [COLOR=darkgreen]'Get the Last Row of the column range the Totals Row[/COLOR]
            .LineStyle = xlContinuous                     [COLOR=darkgreen]'Create continuous lines[/COLOR]
            .Weight = xlThick                               [COLOR=darkgreen]'Set their weight to thick[/COLOR]
        [COLOR=blue]End With[/COLOR]
[COLOR=blue] End With[/COLOR]
    ObjExcel.ActiveWorkbook.Close True  [COLOR=darkgreen]'Close the Active Workbook[/COLOR]
    ObjExcel.Quit                       [COLOR=darkgreen]'Close the Excel Application[/COLOR]
 
    [COLOR=blue]Dim[/COLOR] olApp [COLOR=blue]As[/COLOR] Outlook.Application  [COLOR=darkgreen]'Declare the outlook application variable[/COLOR]
    [COLOR=blue]Dim[/COLOR] olMail [COLOR=blue]As[/COLOR] MailItem            [COLOR=darkgreen]'Declare the Mail Item variable[/COLOR]
    [COLOR=blue]Set[/COLOR] olApp = New Outlook.Application       [COLOR=darkgreen]'Set the olApp to a new outlook application[/COLOR]
    [COLOR=blue]Set[/COLOR] olMail = olApp.CreateItem(olMailItem) [COLOR=darkgreen]'Set the olMail to create an outlook mail item[/COLOR]
    [COLOR=darkgreen]'Create and send an email with an excel attachment[/COLOR]
    [COLOR=blue]With[/COLOR] olMail
        .To = "[EMAIL="Statistics@domesticandgeneral.com"]Statistics@domesticandgeneral.com[/EMAIL]"
        .CC = "[EMAIL="John.Lee@domesticandgeneral.com"]John.Lee@domesticandgeneral.com[/EMAIL]"
        .BCC = "[EMAIL="elaine.boulton@domesticandgeneral.com"]elaine.boulton@domesticandgeneral.com[/EMAIL]"
        .Subject = "Camera Spreadsheet Analysis"
        .Body = "Please find attached the current Calender quarter Camera Excel Spreadsheet."
        .Attachments.Add "M:\Customer Satisfaction\Camera\CameraSpreadsheets\Cam1s0s" & "_" & Format(MyDate, "ddmmyy") & ".xls"
        .Send
    [COLOR=blue]End With[/COLOR]
    [COLOR=blue]Set[/COLOR] olMail = Nothing    [COLOR=darkgreen]'Set the olMail to nothing[/COLOR]
    [COLOR=blue]Set[/COLOR] olApp = Nothing     [COLOR=darkgreen]'Set the olApp to nothing[/COLOR]
Call QuarterlyExportSky     [COLOR=darkgreen]'Call the Quarterly Sky Export Process[/COLOR]
DoCmd.Echo [COLOR=blue]True[/COLOR], "Program End"  [COLOR=darkgreen]'Update the progress bar with the words[/COLOR] [COLOR=darkgreen]"Program End"[/COLOR]
DoCmd.Hourglass [COLOR=blue]False[/COLOR]           [COLOR=darkgreen]'Turn the Hourglass off[/COLOR]
DoCmd.SetWarnings [COLOR=blue]True[/COLOR]          [COLOR=darkgreen]'Turn the warnings on[/COLOR]
[COLOR=blue]End Function[/COLOR]

The above code works for me, the way in which I have put this together may not be how the more proficient Access users would do it, and so you may want to seek additional guidance from that area of expertise.

I hope this will be of assistance to you.

John

 

[Alansidman]

Perhaps the simplest means is to use the DoCmd Transferspreadsheet function.

Here is a link of how it works

http://msdn.microsoft.com/en-us/library/aa141565(v=office.10).aspx

Alan