PDA

View Full Version : [SOLVED] Export and import CSV Date format proble in Excel2010



Jomathr
02-18-2014, 01:05 PM
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
02-19-2014, 04:59 AM
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
02-19-2014, 05:11 AM
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
02-19-2014, 09:11 AM
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!