Export and import CSV Date format proble in Excel2010

[Jomathr]

Good day everyone,

Once again I've been facing a proble I can't seem to solve, this time regarding date format on importing .CSV file to transfer data from one excel to another

here is my export code wich work fine:

Sub ExportCSV()

Dim LastRow As String
Dim sFile As String
Dim sPath As String
Dim sFullName As String


sPath = Feuil3.Range("ParamExportPath").Value
LastRow = Feuil4.Range("B65535").End(xlUp).Row
sFile = "Data_" & Format(Now, "YYYYMMDD_HHMMSS") & ".CSV"
sFullName = sPath & sFile
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False


On Error GoTo Errhandler
    Feuil4.Visible = xlSheetVisible
    Feuil4.Select
    Range("A10:XB" & LastRow).Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.PasteSpecial (xlPasteValuesAndNumberFormats)
    Application.CutCopyMode = False
    With ActiveWorkbook.WebOptions
        .RelyOnCSS = True
        .OrganizeInFolder = True
        .UseLongFileNames = True
        .DownloadComponents = False
        .RelyOnVML = False
        .AllowPNG = True
        .ScreenSize = msoScreenSize1024x768
        .PixelsPerInch = 96
        .Encoding = msoEncodingUTF8
    End With
    With Application.DefaultWebOptions
        .SaveHiddenData = True
        .LoadPictures = True
        .UpdateLinksOnSave = True
        .CheckIfOfficeIsHTMLEditor = True
        .AlwaysSaveInDefaultEncoding = False
        .SaveNewWebPagesAsWebArchives = True
    End With
    ActiveWorkbook.SaveAs Filename:= _
        sFullName, _
        FileFormat:=xlCSV, CreateBackup:=False
    ActiveWindow.Close


On Error GoTo 0


'Supprime les entrées dans la DB
    Feuil4.Select
    Feuil4.Range("A10:XB" & LastRow).ClearContents
    'Feuil4.Visible = xlSheetVeryHidden
    Feuil1.Select
            
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    Exit Sub


Errhandler:


      Select Case Err


         Case 68, 75:    ' Error 68: "Device not available"
                         ' Error 75: "Path/File Access Error"
            MsgBox "Une erreur de lecture du disque " & Mid(sPath, 1, 3) & " est survenu, l'exportation n'est pas complété"
            ActiveWorkbook.Close
            Feuil4.Visible = xlSheetVeryHidden
            Feuil1.Select


         Case 76, 1004:        ' Error 76: "Path not found"
            MsgBox "Le répertoire de destination est introuvable, veuillez modifier le chemin d'accès et réessayer."
            ActiveWorkbook.Close
            Feuil4.Visible = xlSheetVeryHidden
            Feuil1.Select


         Case Else:      ' Erreur autre que 68, 75 or 76 has occurred.
            MsgBox "Erreur # " & Err & " : " & Error(Err) & ". Some text"
            Feuil4.Visible = xlSheetVeryHidden
            Feuil1.Select


      End Select


    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

The format before exporting to the csv for the date column is YYYY-MM-DD and if I check directly in the created CSV it is converted to MM/DD/YYYY

now for the import code:

Sub ImportCSV()

Dim sPath As String
Dim StartLine As String
Dim sFile As String
Dim sFullName As String


sPath = Feuil3.Range("ParamExportPath").Value
sFile = Dir(sPath & "*.csv")
StartLine = Feuil4.Range("A1048576").End(xlUp).Offset(1, 0).Address
sFullName = sPath & sFile


Application.ScreenUpdating = False
Application.DisplayAlerts = False


On Error GoTo Errhandler
   
While sFile <> ""
    Feuil4.Visible = xlSheetVisible
    Feuil4.Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & sFullName _
        , Destination:=Range(StartLine))
        '.CommandType = 0
        '.Name = ActiveWorkbook '"CSVnow3"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65000
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, xlYMDFormat, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
    sFile = Dir
Wend


Feuil4.Range("C10,C650000").NumberFormat = "yyyy/mm/dd"
'déplace dans le sous-répertoire backup et Supprime le fichier csv
Dim d As String, ext, x
Dim destPath As String, SrcFile As String
destPath = sPath & "\Backup\"
ext = Array("*.csv")


Dim DBDataset As String
DBDataset = Feuil4.Range("XB165535").End(xlUp).Address
Feuil4.Range("A9:" & DBDataset).Name = "DataXD"


If Dir(destPath, vbDirectory) = vbNullString Then MkDir destPath 'Crée le répertoire backup si il n'existe pas


For Each x In ext
    d = Dir(sPath & x)
        Do While d <> ""
            SrcFile = sPath & d
            FileCopy SrcFile, destPath & d
            Kill SrcFile
            d = Dir
        Loop
Next






Feuil4.Visible = xlSheetVeryHidden
Feuil1.Select


On Error GoTo 0


    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
Exit Sub


Errhandler:


      Select Case Err


         Case 68, 75:    ' Error 68: "Device not available"
                         ' Error 75: "Path/File Access Error"
            MsgBox "Une erreur de lecture du disque " & Mid(sPath, 1, 3) & " est survenu, l'exportation n'est pas complété"
            Feuil4.Visible = xlSheetVeryHidden


         Case 76, 1004:        ' Error 76: "Path not found"
            MsgBox "Le répertoire d'importation est introuvable, veuillez modifier le chemin d'accès et réessayer."
            Feuil4.Visible = xlSheetVeryHidden
        
        Case 53:        ' Error 53: "File not found"
            MsgBox "Aucun fichier d'importation n'est présent dans le répertoire sélectionné"
            Feuil4.Visible = xlSheetVeryHidden
            
         Case Else:      ' Erreur autre que 68, 75 or 76 has occurred.
            MsgBox "Erreur # " & Err & " : " & Error(Err) & ". Some text"
            Feuil4.Visible = xlSheetVeryHidden


      End Select
          
Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

the 3rs column in the array is my date column, I tried using 5, xlYMDFormat, "YYYY-MM-DD" in the .TextFileColumnDataTypes nothing will set the date in the correct format wich is suppose to be YYYY-MM-DD but I always end up with DD-MM-YYYY wich is not even the format from the cvs file.

Also, the whole column in my table that receive the dates is formated to output it in YYYY-MM-DD before import.

anyone have a clue regarding this?

[westconn1]

maybe it would be more reliable to pass the date value as double then change the number format after it is imported
change the numberformat of the date column in the new workbook to number before saving as csv

if of course you need to see the dates within the csv, this may not be a useful solution

[Jomathr]

I will try that,

since it's 2 exact same excel file that is used to import and export I'll have to play with columns format, the idea is to export from one application and emptying the data table to import it to another and append the results. I tried something similar last week but was causing problems when I had to deal with 2 type of data in the importing side's column. Will try to convert it before adding it to table this time.

I'll let you know how it turns out

Thank you

[Jomathr]

Ok I was able to fix it so now it works:

Thank you westconn1 for putting me on the right track!

I know there is a bug with the csv import/export from reading it in multiple forums but here is how I worked around it:

1 - I converted the column to number format before exporting using:

Range("C10:C65535").NumberFormat = "0"

2 - Exported the file using the code in my first post

3 - revert the range back to "Date" using

Feuil4.Range("C10:C65535").NumberFormat = "yyyy/mm/dd"

in the exporting module:

1- convert the column to numbers using:

Range("C10:C65535").NumberFormat = "0"

2- This is where it was messing up, in the .TextFileColumnDataTypes put the field associated to your column to the constant "1" (general numbers) as it will not convert it correctly using those mentionned in my first post
3rd argument in my case

.TextFileColumnDataTypes = Array(1, 1, 1)

3- Finally convert the column to date using:

Feuil4.Range("C10:C65535").NumberFormat = "yyyy/mm/dd"

Thank you for the help once again!