Export to excel change numbers to dates

[ejesper]

Hi,

I have a problem when i export my data from a query to Excel. All my field with numbers (have tried different number format) changes to date type in excel with CopyFromRecordset.
But it doesn't happen when I use

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                     strDocName, strFullName, True

I have cleaned the code from some tests but the export looks like this:

Public Function OpenExcelAddWorkbook(strFullFileName As String, strWorkbookName As String, _
        strQueryName As String, Optional blnClose As Boolean) As Boolean
        'Format and open Excel spreadsheet
On Error GoTo Err_Proc

    Dim objApp As Object
    Dim intSR As Integer
    Dim dbs As DAO.Database
    Dim rsRecords As DAO.Recordset
    Dim strMsg As String
    Dim lngMaxCol As Long
    Dim lngMaxRow As Long
    Dim i As Long
    Dim strHeading As String
    Dim blnWorksheetExists As Boolean
    Dim blnSpreadsheetExists As Boolean
    ' Open database
    Set dbs = CurrentDb
    
    ' Open recordset
    Set rsRecords = dbs.OpenRecordset(strQueryName)
    
    If rsRecords.EOF And rsRecords.BOF Then
        MsgBox "Query or SQL returned no records.", vbCritical + vbOKOnly, "Error"
        Exit Function
    End If
    
    ' Open excel and add workbook
    Set objApp = CreateObject("Excel.Application")
    objApp.UserControl = True
    
 
      
    ' Prompts are enabled to prevent overwriting of existing spreadsheet
    objApp.DisplayAlerts = True
    objApp.ActiveWorkbook.Worksheets(strWorkbookName).Activate
    
       
    With objApp.Worksheets("" & strWorkbookName & "")
        lngMaxCol = rsRecords.Fields.Count
    
        If rsRecords.RecordCount > 0 Then
            rsRecords.MoveLast
            rsRecords.MoveFirst
            lngMaxRow = rsRecords.RecordCount
    
                    
            ' Let user see the data added
        
            objApp.Visible = True
            objApp.ScreenUpdating = False
            For i = 1 To lngMaxCol
                .Cells(1, i).FormulaR1C1 = rsRecords.Fields(i - 1).Name
                .Cells(1, i).Font.Bold = True
            
                .Cells(1, i).Font.ColorIndex = 1
                .Cells(1, i).Interior.ColorIndex = 35
                .Cells(1, i).Interior.Pattern = 1 'Excel ref variable xlSolid = 1
                .Cells(1, i).Interior.PatternColorIndex = -4105 'Excel ref variable PatternColorIndex = -4105
                
            Next
            
            .Range(.Cells(2, 1), .Cells(lngMaxRow, lngMaxCol)).CopyFromRecordset rsRecords
            'Excel ref variable xlLeft = -4131
            .Range(.Cells(1, 1), .Cells(lngMaxRow + 1, lngMaxCol)).HorizontalAlignment = -4131
            .Range(.Cells(1, 1), .Cells(lngMaxRow + 1, lngMaxCol)).AutoFilter
            .Range(.Cells(1, 1), .Cells(lngMaxRow + 1, lngMaxCol)).EntireColumn.AutoFit
        
        End If
        
        ' Select all data
        .Range(.Cells(1, 1), .Cells(lngMaxRow + 1, lngMaxCol)).Select
        
    End With
    objApp.ScreenUpdating = True
    rsRecords.Close
    Set rsRecords = Nothing
    
    ' Save excel spreadsheet
    If blnSpreadsheetExists Then
        objApp.ActiveWorkbook.Save
    Else
        objApp.ActiveWorkbook.SaveAs strFullFileName
    End If
    
    ' Reset alerts prompts
    objApp.DisplayAlerts = True
    Set dbs = Nothing
    If blnClose Then
        objApp.Quit
    End If
    
    OpenExcelAddWorkbook = True
    
Exit_Proc:
    Exit Function
    
Err_Proc:
    
    If Err.Number = 9 Then
        blnWorksheetExists = False
        Resume Next
    Else
        MsgBox Err.Number & "-" & Err.Description
        Resume Exit_Proc
    End If
End Function

Does someone know why this happens and how I can prevent it?


Thanks
Jesper

[ejesper]

Hi again,

Find out that the data types in Excel become general for all fields before the date field and after the date field all was of date type.

I have solved my problem by add this code in my export function.

For i = 1 To lngMaxCol
                If .cells(1, i) Like "*NumOfErr*" Then
                    .Range(.cells(2, i), .cells(lngMaxRow + 1, i)).NumberFormat = "0"
                ElseIf .cells(1, i) Like "Entry Date" Then
                    .Range(.cells(2, i), .cells(lngMaxRow + 1, i)).NumberFormat = "m/d/yyyy"
                Else
                    .Range(.cells(2, i), .cells(lngMaxRow + 1, i)).NumberFormat = "@"
                End If
            Next

Where I use the title for each field to change the data type.

//Jesper