Copying data to Excel, date wrong format

[wrightyrx7]

Hi all,

I use the code below to copy data from a subform to Excel.

However, some of the dates are coming out "mm/dd/yyyy" instead of "dd/mm/yyyy" (not all of them though). Is there a way to make sure they all come out "dd/mm/yyyy"?

Thanks in advance.

Private Sub cmdExport_Click()
    '*******************************************
    '**********EXPORT TO EXCEL BUTTON***********
    '*******************************************
    Me.[tblDetails subform].SetFocus                'line 1: Selects the subform
    Me.[tblDetails subform]![CaseID].SetFocus           'Line 2: sets the focus in the first field/record in the subform
    DoCmd.RunCommand acCmdSelectAllRecords  'Select all the records-ie including filtred records
    DoCmd.RunCommand acCmdCopy              'Copy the selected record
    Me.cboEmpID.SetFocus
    Dim xlapp As Object
    
    Set xlapp = CreateObject("Excel.Application") 'create an excel application object
    With xlapp
    .Workbooks.Add 'add new workbook in the excel
   [COLOR="Red"] .activesheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False ' Line 10[/COLOR]
    'Line 10: paste the copied records,not as a link please
    .Cells.HorizontalAlignment = -4131
    .Cells.Rows.AutoFit
    .Selection.AutoFilter
    .Cells.Columns.AutoFit
    '***************************************************************************************
    'Now loop through the rows starting from row 1 to 19 which is A1 to S1 and apply formating as below
    Dim i As Integer
    For i = 1 To 12
        .Cells(1, i).Font.Bold = True
        .Cells(1, i).Font.ColorIndex = 3
        .Cells(1, i).Interior.ColorIndex = 37
    Next 'end of loop
    '****************************************************************************************
     
    .Worksheets(1).Cells(2, 2).Activate ' make cell B2 as the active cell
    .ActiveWindow.FreezePanes = True 'Now freezepanes from the active cell B2
    .Visible = True
    .Range("a1").SELECT 'If for some reason if other cells are selected please select A1 as am now done.
     
    End With
export_Click_Exit:
    Exit Sub
export_Click_Err:
    MsgBox Error$
    Resume export_Click_Exit

End Sub

 

[Isskint]

Hi Wrighty

Welcome to (one of) the biggest bugbear in MS Office. Dates are stored as double-precision, floating-point numbers. What you see is dependent on the format(s) in place. However whenever you do something like copy paste, the formatting 'runs home to momma' and reverts the formatting being used to American standard mmddyyyy.

You will need to identify the best option to your scenario to resolve this. You can use DateSerial() function, convert date field to a Double variable..... There are a whole load of ways.

Is there a reason you use a custom function to export rather than using DoCmd.TransferSpreadsheet()?

 

[wrightyrx7]

Hi Wrighty

Welcome to (one of) the biggest bugbear in MS Office. Dates are stored as double-precision, floating-point numbers. What you see is dependent on the format(s) in place. However whenever you do something like copy paste, the formatting 'runs home to momma' and reverts the formatting being used to American standard mmddyyyy.

You will need to identify the best option to your scenario to resolve this. You can use DateSerial() function, convert date field to a Double variable..... There are a whole load of ways.

Is there a reason you use a custom function to export rather than using DoCmd.TransferSpreadsheet()?

Hi Isskint,

Thank you for your prompt reply. The only reason i am using a function is because im letting the user use the filters on the subform then click the export button to put the remaining data into Excel.

From what i have read im sure that the DoCmd.TransferSpreadsheet ignores the filters that are applied?

For some reason all the users prefer to filter the data down before they click export. When they could just export then filter which would make my life easier.

If there is a way you think this task would be easier im willing to change the layout for format of my forms.

Thanks again
Chris

 

[Isskint]

Hi Chris

The proper way (well my way anyway) to handle this sort of scenario starts with a query that acts as the datasource for your form.

Easy Option If you provide filter options on the form (eg comboboxes, textboxes etc) include those as criteria in your query. You can then use this query as the datasource for the TransferSpreadsheet method

Complicated Option If you allow 'free' filtering EG using built in filtering options, you will need a second query. When the user click Export a little VBA will add the filtering currently applied to the form to query2 before using it as the datasource for the TransferSpreadsheet method.

So, to help you further,
1. Do you allow free filtering?
2. Do you use a query as the forms recordsource currently?

 

[wrightyrx7]

So, to help you further,
1. Do you allow free filtering?
2. Do you use a query as the forms recordsource currently?

A1. At the moment I allow free filtering but may switch it for a couple of comboboxes instead if its easier.

A2. The recordsource at the minute is a table, queried by the subform which is displayed on my main form.

I dont mind changing the forms about. Making the subform get its data from a query of the table should be pretty straight forward

 

[arnelgp]

you can use recordset to import to the worksheet:

Private Sub cmdExport_Click()
    '*******************************************
    '**********EXPORT TO EXCEL BUTTON***********
    '*******************************************
    Me.[tblDetails subform].SetFocus                'line 1: Selects the subform
    Me.[tblDetails subform]![CaseID].SetFocus           'Line 2: sets the focus in the first field/record in the subform
    'DoCmd.RunCommand acCmdSelectAllRecords  'Select all the records-ie including filtred records
    'DoCmd.RunCommand acCmdCopy              'Copy the selected record
    Me.cboEmpID.SetFocus
    Dim xlapp As Object
    Dim xlSht As Object
    Dim i As Integer
    Dim db As DAO.Database
    Dim rs As DAO.recordSet
    Dim strSQL As String
    
    ' build sql string
    strSQL = "Select FROM " & Me.[tblDetails subform].Form.RecordSource
    If Me.[tblDetails subform].Form.FilterOn Then
        strSQL = strlsql & " Where " & Me.[tblDetails subform].Form.Filter
    End If
    strSQL = strSQL & ";"
    
    ' open recordset
    Set db = CurrentDb
    Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
    
    Set xlapp = CreateObject("Excel.Application") 'create an excel application object
    With xlapp
    .Workbooks.Add 'add new workbook in the excel
    Set xlSht = xlapp.ActiveWorkbook.ActiveSheet
    ' write the column header on the worksheet
    For i = 0 To rs.Fields.Count - 1
        xlSht.Cells(1, i + 1).value = rs.Fields(i).Name
    Next
    ' write the data on the worksheet
    xlSht.Range("a2").CopyFromRecordset rs
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    '.ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False ' Line 10
    'Line 10: paste the copied records,not as a link please
    .Cells.HorizontalAlignment = -4131
    .Cells.Rows.AutoFit
    .Selection.AutoFilter
    .Cells.Columns.AutoFit
    '***************************************************************************************
    'Now loop through the rows starting from row 1 to 19 which is A1 to S1 and apply formating as below
    For i = 1 To 12
        .Cells(1, i).Font.Bold = True
        .Cells(1, i).Font.ColorIndex = 3
        .Cells(1, i).Interior.ColorIndex = 37
    Next 'end of loop
    '****************************************************************************************
    
    .Worksheets(1).Cells(2, 2).Activate ' make cell B2 as the active cell
    .ActiveWindow.FreezePanes = True 'Now freezepanes from the active cell B2
    .Visible = True
    .Range("a1").Select 'If for some reason if other cells are selected please select A1 as am now done.
    
    End With
export_Click_Exit:
    Exit Sub
export_Click_Err:
    MsgBox Error$
    Resume export_Click_Exit
    
End Sub