Excel Import Data from SQL- Date comes in as text value

Question

I'm importing data from oracle toad database into an Excel sheet using data connection. The table includes a Date column, but this column comes to Excel as text rather than the date.

Is there any way I can fix this issue?

Sub Show_data()


    Dim con As ADODB.Connection
    Dim recset As ADODB.Recordset
    Dim ConnectionString As String
    Dim strSQL As String
    Dim iCols As Integer


    Set con = New ADODB.Connection
    Set recset = New ADODB.Recordset

'Check for the connectivity or connected to the xx network
    On Error GoTo errHandler


    ConnectionString = "Provider=xx;User ID=yy;password= appsro;Data Source=zz"

    con.Open ConnectionString

    'Set and Excecute SQL Command'

        strSQL = "SELECT B.USER_NAME AS CREATED_BY, A.CREATION_DATE, C.USER_NAME, A.LAST_UPDATE_DATE, A.PFIZER_ITEMCODE, A.SYSTEM_ITEMCODE AS ORACLE_ITEM_CODE, " & _
        "A.ITEM_DESCRIPTION, A.BATCH_NUMBER, A.MFR_CODE, A.MFR_DESC AS MFR_DESCRIPTION, TO_CHAR(A.MFR_DATE,'DD-MON-YYYY')As MFR_DATE, TO_CHAR(A.EXPIRY_DATE,'DD-MON-YYYY')As EXPIRY_DATE, " & _
        "TO_CHAR(A.EFFECTIVE_FROM,'DD-MON-YYYY') AS EFFECTIVE_FROM, " & _
        "A.EFFECTIVE_TO, A.EXCISE AS EXCISE_AMOUNT, A.EXCISE_RATE, A.P2S, A.P2R, A.MRP, A.STATE_CODE, A.STATE, " & _
        "(CASE SUBSTR(A.SYSTEM_ITEMCODE,6,2) WHEN ('PI') THEN 'OIP' WHEN ('PF') THEN 'OPF' ELSE 'OWL' END )AS LEGAL_ENTITY " & _
        "FROM xxdhl_pf_batch_pricing A JOIN fnd_user B ON A.CREATED_BY = B.USER_ID " & _
        "JOIN fnd_user C ON A.LAST_UPDATED_BY = C.USER_ID WHERE "


        If (ActiveSheet.cmbLE.Text) <> "" Then
        strSQL = strSQL & " (CASE SUBSTR(A.SYSTEM_ITEMCODE,6,2) WHEN ('PI') THEN 'OIP' WHEN ('PF') THEN 'OPF' ELSE 'OWL' END )='" & ActiveSheet.cmbLE.Text & "'"
        End If

        If (ActiveSheet.cmbProduct.Text) <> "" Then
            If (ActiveSheet.cmbLE.Text) <> "" Then
                strSQL = strSQL & " AND A.SYSTEM_ITEMCODE='" & ActiveSheet.cmbProduct.Text & "'"
            Else
                strSQL = strSQL & " A.SYSTEM_ITEMCODE='" & ActiveSheet.cmbProduct.Text & "'"
            End If
        End If

        If (ActiveSheet.txtBatch.Text) <> "" Then
            If (ActiveSheet.cmbLE.Text) <> "" Or (ActiveSheet.cmbProduct.Text) <> "" Then
                strSQL = strSQL & " AND A.BATCH_NUMBER='" & ActiveSheet.txtBatch.Text & "'"
            Else
                strSQL = strSQL & " A.BATCH_NUMBER='" & ActiveSheet.txtBatch.Text & "'"
            End If
        End If

        If (ActiveSheet.txtfromdt.Text) <> "" Then
            If (ActiveSheet.txtfromdt.Text) <> "" And (ActiveSheet.txtTodt.Text) <> "" Then

            Else
                strSQL = strSQL & " AND TRUNC(A.EFFECTIVE_FROM) BETWEEN TO_DATE('" & ActiveSheet.txtfromdt.Text & "','DD-MON-YYYY') AND TO_CHAR(SYSDATE ,'DD-MON-YYYY') "
            End If
        End If

        If (ActiveSheet.txtfromdt.Text) <> "" And (ActiveSheet.txtTodt.Text) <> "" Then
            If (ActiveSheet.cmbLE.Text) <> "" Or (ActiveSheet.cmbProduct.Text) <> "" Or (ActiveSheet.txtBatch.Text) <> "" Then
                strSQL = strSQL & " AND TRUNC(A.EFFECTIVE_FROM) BETWEEN TO_DATE('" & ActiveSheet.txtfromdt.Text & "','DD-MON-YYYY') AND TO_DATE('" & ActiveSheet.txtTodt.Text & "','DD-MON-YYYY') "
            Else
                strSQL = strSQL & " TRUNC(A.EFFECTIVE_FROM) BETWEEN TO_DATE('" & ActiveSheet.txtfromdt.Text & "','DD-MON-YYYY') AND TO_DATE('" & ActiveSheet.txtTodt.Text & "','DD-MON-YYYY') "
            End If
        End If



    'Open Recordset

    Set recset.ActiveConnection = con
    If recset.State = adStateOpen Then recset.Close
    recset.CursorLocation = adUseClient
    recset.Open strSQL, con, adOpenKeyset, adLockOptimistic

    For iCols = 0 To recset.Fields.Count - 1
        Worksheets("Sheet2").Cells(1, iCols + 1).Value = recset.Fields(iCols).Name
    Next

    'Copy the data
    If recset.RecordCount > 0 Then
    Sheets("Sheet2").Range("A2").CopyFromRecordset recset
    Else
    MsgBox "No Data Available", vbExclamation + vbOKOnly, ""
    Exit Sub
    End If




recset.Close
con.Close


errHandler:
    If Err.Number = -2147467259 Then
        MsgBox "Please check for the xx connectivity ", vbExclamation + vbOKOnly
        Exit Sub
    End If

End Sub

Actual result - 6/5/2015 4:12:47 PM but In Excel - 42160.67554

Please help :(

Answer 1

Which columns are you referring to as you have a mixture of logic when it comes to dates in your SQL query.

CREATION_DATE and LAST_UPDATE_DATE should work fine and simply need formatting like @KazimierzJawor said. Something like:-

  Range("B5:B10, D5:D10").NumberFormat = "m/d/yyyy h:mm:ss AM/PM"

If you are referring to MFR_DATE, EXPIRY_DATE and EFFECTIVE_FROM columns, then you should remove the TO_CHAR functions as this is forcing the data to be text. Once you have removed the functions, you should be able to format those columns using the same technique as shown above.