Results 1 to 6 of 6
  1. #1
    Join Date
    Mar 2010
    Posts
    4

    Unanswered: Exporting to Excel Based on Changes in table

    Hello,
    I have an access 2007 database that has a large table of clients and related information. That is to say the client ID can be listed multiple times on the table and the table has multiple client IDs.

    I have searched all over looking for a way to automatically run code to export this table to excel but creating one spreadsheet for each client (so the client can have one file with all their information).

    I am looking for some type of code that will say something like, for each client create a new spreadsheet. I was hoping to avoid creating a separate SQL string for each client ID (since they change often - additions/deletions).

    Is this possible?

  2. #2
    Join Date
    Mar 2009
    Posts
    5,441
    Provided Answers: 14
    If the Client ID is not unique in the table you obviously have a problem of normalization in your database structure. However what you could do is:
    Code:
    Option Compare Database
    Option Explicit
    
    Function ExportClientsToExcel()
    
        Dim rst As DAO.Recordset
        Dim strSQL As String
        
        strSQL = "SELECT DISTINCT Client_ID FROM Clients"
        Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
        With rst
            Do Until .EOF
                strSQL = "SELECT * FROM Clients WHERE Client_ID = " & !Client_ID
                ExportToExcel strSQL, CStr(!Client_ID) & ".xls", True
                .MoveNext
            Loop
            .Close
        End With
        Set rst = Nothing
    
    End Function
    
    Function ExportToExcel(ByVal DataObject As String, ByVal FileName As String, ByVal IncludeHeader As Boolean) As Long
    
    ' Purpose:      Export a data set to an Excel file using OLE.
    ' -------
    '
    ' Dependencies: Must have a reference to the Microsoft Excel Object Library.
    ' ------------
    '
    ' Parameters:   DataObject:    Can be the name of a table or query, or a valid SQL SELECT statement.
    ' ----------    FileName:      The name of the .xls file to create.
    '               IncludeHeader: If True, the first line of the Excel sheet contains the columns name.
    '
    ' Usage:        Table: ExportToExcel "Tbl_Customers", "Customers.xls", True
    ' -----         Query: ExportToExcel "Qry_Customers", "Customers.xls", True
    '               SQL:   ExportToExcel "SELECT * FROM Tbl_Customers ORDER BY Name;", "Customers.xls", True
    '
    ' To do:        - Handle errors.
    ' -----         - Properly handle the case when the are more than 26 columns in the data set.
    '
        Dim appXl As Excel.Application
        Dim rst As DAO.Recordset
        Dim fld As DAO.Field
        Dim intRow As Integer
        Dim strcell As String
        
        Set rst = CurrentDb.OpenRecordset(DataObject, dbOpenSnapshot)
        Set appXl = New Excel.Application
        With appXl
            .Visible = True ' Optional: don't use in "quiet" mode.
            .Workbooks.Add
            .Sheets.Add
            .ActiveSheet.Name = DataObject
            intRow = 1
            If IncludeHeader = True Then
                For Each fld In rst.Fields
                    Select Case fld.OrdinalPosition
                        
                        ' Should use a more generalist algorithm
                        ' that would be able to handle all cases.
                        '
                        Case 0 To 25    ' Cells "An" to "Zn"
                            strcell = Chr(65 + fld.OrdinalPosition) & CStr(intRow)
                        Case 26 To 51   ' Cells "AAn" to "AZn"
                            strcell = "A" & Chr(65 + fld.OrdinalPosition) & CStr(intRow)
                        Case Else ' etc.
                    End Select
                    .Range(strcell).Select
                    .ActiveCell.FormulaR1C1 = fld.Name
                Next
                intRow = intRow + 1
            End If
            Do Until rst.EOF
                For Each fld In rst.Fields
                    Select Case fld.OrdinalPosition
                        
                        ' See above.
                        '
                        Case 0 To 25
                            strcell = Chr(65 + fld.OrdinalPosition) & CStr(intRow)
                        Case 26 To 51
                            strcell = "A" & Chr(65 + fld.OrdinalPosition) & CStr(intRow)
                    End Select
                    .Range(strcell).Select
                    .ActiveCell.FormulaR1C1 = fld.Value
                Next
                rst.MoveNext
                intRow = intRow + 1
            Loop
            rst.Close
            Set rst = Nothing
            .ActiveWorkbook.SaveAs FileName
            .Quit
        End With
        Set appXl = Nothing
    
    End Function
    This will be slow if you have many rows in the table, though.
    Have a nice day!

  3. #3
    Join Date
    Mar 2010
    Posts
    4
    Thanks for this...it works like a champ.

    One question though...is there a way to tell the export function to export as text? I have some values that (are stored in the database table as text) so as to preserve the leading zeros. When this is exported to excel it comes out as a number and excel strips out the leading zeros.

    For example the database field has 00012345 but in the export it ends up as 12345. the leading zeros are important to preserve.

    I looked at some examples and see how the data is being loaded to the spreadsheets but I am not sure what the command is that allows me to set the formatting.

    It is acceptable to export the entire table (all fields) as text.


    Thanks again!

  4. #4
    Join Date
    Mar 2009
    Posts
    5,441
    Provided Answers: 14
    It's possible. In the ExportToExcel function, when you address a cell that you want to stay of text format, use its Numberformat property, like this:
    Code:
        .Range(strcell).Select
        .Selection.NumberFormat = "@"
        .ActiveCell.FormulaR1C1 = fld.Value
    voila!
    Have a nice day!

  5. #5
    Join Date
    Mar 2010
    Posts
    4
    I posted my question a bit to early...I just found something similar just before your reply...but i was missing the '.selection' part.

    Many thanks.

  6. #6
    Join Date
    Mar 2009
    Posts
    5,441
    Provided Answers: 14
    You're welcome!
    Have a nice day!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •