[rconverse]

When I try to export a table into an Excel worksheet, I lose the formatting or the column widths and I always have to open the Excel file and format the columns.

Is there a way to export to Excel that will keep the integrity of my columns when it exports?

Thank you,
Roger

[qucho]

just check the box 'keep formatting' in the lower right corner of the export dialog. =P

[rconverse]

I am exporting using a docmd.transferspreadsheet code. I am not manually exporting the files, so I can't check that box.

Thanks,
Roger

[qucho]

Then you need to create an Excel object open the file where you exported your data, and then format the spreadsheet.

or... use the function below instead = )

This function will insert data to Excel from a ADO recordset. If will spread the data in multiple sheets of there are more than 65535 rows ( or the specified max rows by you).

Public Function RecordsetToExcelMod(ByRef ERST As Recordset, _
    Optional ByVal SpreadsheetName As String = "Sheet", _
    Optional ByVal lMaxRows As Long = 65535)
'Use this to generate an Excel application from an ADO recordset.

Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlws As Excel.Worksheet
Dim rstTemp As ADODB.Recordset
Dim rstField As ADODB.Field

Dim iCol As Integer
Dim lRow As Long
Dim iTotSheets As Integer
Dim iShe As Integer

Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Add
Set rstTemp = New ADODB.Recordset

If lMaxRows > 65535 Then
    lMaxRows = 65535
End If

' Copy fields to the temporary recordset
For Each rstField In ERST.Fields
    rstTemp.Fields.Append rstField.Name, rstField.Type, rstField.DefinedSize, rstField.Attributes And adFldIsNullable
    rstTemp(rstField.Name).Precision = rstField.Precision
    rstTemp(rstField.Name).NumericScale = rstField.NumericScale
Next
rstTemp.Open

ERST.MoveFirst

' Calculate how many sheets will be needed
iTotSheets = (ERST.RecordCount / lMaxRows) + 0.5

For iShe = 1 To iTotSheets
    ' Create additional sheets if necesary
    If iShe > 3 Then
        ' Creates a new sheet after the previous one
        xlWb.Worksheets.Add , xlWb.Worksheets(iShe - 1)
    End If
    Set xlws = xlWb.Worksheets(iShe)
    xlws.Activate
    xlws.Name = Left(SpreadsheetName & " " & iShe & " of " & iTotSheets, 31)
    
    ' Create column names in the spreadsheet
    For iCol = 1 To ERST.Fields.count
        xlws.Cells(1, iCol).Value = ERST.Fields(iCol - 1).Name
    Next
    xlApp.Selection.CurrentRegion.Font.Bold = True
    
    ' Copy records to temporary recordset.
    ' Only copy the maximum allowed per sheet
    For lRow = 1 To lMaxRows
        If ERST.EOF Then
            Exit For
        Else
            rstTemp.AddNew
            For iCol = 0 To (ERST.Fields.count - 1)
                rstTemp.Fields(iCol).Value = ERST.Fields(iCol).Value
            Next
            rstTemp.Update
            rstTemp.MoveNext
            ERST.MoveNext
        End If
    Next
    ' CopyFromRecordset is faster then copying row by row to the spreadsheet.
    ' This is why we use a temporary recordset.
    xlws.Cells(2, 1).CopyFromRecordset rstTemp
    If rstTemp.RecordCount > 0 Then
        rstTemp.MoveFirst
    End If
    ' Empty temporary recordset.
    Do While Not rstTemp.EOF
        If Not rstTemp.EOF Then
            rstTemp.Delete
        End If
        rstTemp.MoveNext
    Loop
    rstTemp.UpdateBatch
    ' Format spreadsheet
    xlApp.Selection.CurrentRegion.Columns.AutoFit
    xlApp.Selection.CurrentRegion.Rows.AutoFit
    
Next

xlApp.Visible = True
xlApp.UserControl = True

Set xlws = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
Set rstTemp = Nothing

End Function