Combined multiple CSV files to single worksheet maintaining date time formatting - vba

Question

So I have been going around in circles trying to find an answer to what should be a basic file combination.
I have a weeks worth of CSV files generated.
I need to combine the files into a single worksheet with the data stacked
Original file has 2 of the columns that are date and time combined (d/mm/yyyy h:mm:ss)
I have my VBA code combining the data as required but the time formatting is screwed in the master file (d/mm/yyyy h:mm)
Can someone help please with my code :(
Option Explicit
Sub ImportCSVsWithReference()
'Summary: Import all CSV files from a folder into a single sheet
' adding a field in column A listing the CSV filenames
Dim wbCSV As Workbook
Dim wsMstr As Worksheet: Set wsMstr = ThisWorkbook.Sheets("MasterCSV")
Dim fCSV As String
Dim fList As String
Dim fName As String
Dim fd As FileDialog
Dim FileChosen As Integer
Dim FileName As String
Dim i As Integer
Dim wbCSVDisplayOrder As Long
Dim M As Long
'Select the correct files for merge
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'use the standard title and filters, but change the
'initial folder
fd.InitialFileName = "C:\RTVis\OT"
fd.InitialView = msoFileDialogViewList
'allow multiple file selection
fd.AllowMultiSelect = True
FileChosen = fd.Show
If FileChosen = -1 Then
'open each of the files chosen
For i = 1 To fd.SelectedItems.Count
Workbooks.Open fd.SelectedItems(i)
Next i
End If
'clear master page of previous data
If MsgBox("Clear the existing MasterCSV sheet before importing?", vbYesNo, "Clear?") _
= vbYes Then wsMstr.UsedRange.Clear
Application.ScreenUpdating = False 'speed up macro
'Combine files
'start the CSV file listing
fCSV = Dir(fName & "*.csv")
Do While Len(fCSV) > 0
'open a CSV file
Set wbCSV = Workbooks.Open(fName & fCSV)
'copy date into master sheet and close source file
ActiveSheet.UsedRange.Copy wsMstr.Range("A" & Rows.Count).End(xlUp).Offset(0)
wbCSV.Close False
'ready next CSV
fCSV = Dir
Loop
Application.ScreenUpdating = True
End Sub

Answer 1

If I understand you correctly, your problem is with the date/time formatting being munged by Excel when you open the file, but the parsing works properly otherwise.
When Excel sees what looks like a date, it will try to interpret it in accord with your Windows Regional Settings. So if the date in the file is DMY, and your settings at MDY, the dates will not be interpreted properly.
Workaround 1: Change your windows regional settings to match those in the CSV file
Workaround 2: Use the QueryTables method. You can get the VBA equivalent by using the macro recorder and executing, from native Excel, Data ► Get External Data ► From Text Files This will allow specification of the date format. But you must be careful about not adding them multiple times but by refreshing them instead or first deleting them and then adding them again.
Workaround 3: Write your own parsing routine to parse the raw data. Probably should use the FileSystemObject if doing this.
Workaround 4: Change the file suffix to something other than .csv, and then use the OpenText method. This requires the least changes to your existing code. You create a new file; import that; then delete it. The code below demonstrates that process, but does NOT do the other things that you want.
If you use 4, you should add some error handling in case the file copy / delete process goes awry. My favorite options would be 2 or 3.
Sample Code
Option Explicit
Sub foo()
Dim WB As Workbook, wbCSV As Workbook, swbCSV As String
Dim sFN As String, sCopyFN
Dim FD As FileDialog
Set WB = ThisWorkbook
Set FD = Application.FileDialog(msoFileDialogFilePicker)
With FD
.AllowMultiSelect = False
.Filters.Add "Text or CSV", "*.txt, *.csv", 1
.Show
sFN = .SelectedItems(1)
End With
'If CSV, remove suffix
sCopyFN = ""
If sFN Like "*.csv" Then
sCopyFN = Left(sFN, Len(sFN) - 4)
FileCopy sFN, sCopyFN
sFN = sCopyFN
End If
Workbooks.OpenText Filename:=sFN, DataType:=xlDelimited, origin:=437, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
FieldInfo:=Array(Array(1, xlDMYFormat), Array(2, xlGeneralFormat))
Set wbCSV = ActiveWorkbook
'Get path as string since it will not be available after closing the file
swbCSV = wbCSV.FullName
'Move the data into this workbook
Dim rCopy As Range, rDest As Range
With WB.Worksheets("sheet1")
Set rDest = .Cells(.Rows.Count, 1).End(xlUp)
End With
Set rCopy = wbCSV.Sheets(1).UsedRange
rCopy.Copy rDest
'must close the file before deleting it
wbCSV.Close False
Kill swbCSV
End Sub