Excel VBA - Error Parsing Dates, Handling Strings - excel

Question

The problem I have concerns a CSV file that I am seeking to parse into an excel spreadsheet.
An example of the data is as follows:-
01/02/2015,MXP,0.4,150.00,Producing design document, 64111258
02/06/2015,IHM,0.8,210.00,"Maximilian dolce, lorem ipsum", 64111258
02/06/2015,AXSP,0.6,250.00,"Magnificent, thanks very much", 64111258
Currently, this is the code I am using to parse the data:-
Sub OpenCSV()
Dim filePath As String
Dim intChoice As Integer
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
intChoice = Application.FileDialog(msoFileDialogOpen).Show
rowIndex = 0
If intChoice <> 0 Then
filePath = Application.FileDialog( _ msoFileDialogOpen).SelectedItems(1)
Open filePath For Input As #1
Do Until EOF(1)
Line Input #1, LineFromFile
LineItem = Split(LineFromFile, ",")
Sheets("Sheet2").Cells(11, 2).Offset(rowIndex, 0).Value = LineItem(0) ' Date
Sheets("Sheet2").Cells(11, 2).Offset(rowIndex, 1).Value = LineItem(1) ' Code
Sheets("Sheet2").Cells(11, 2).Offset(rowIndex, 2).Value = LineItem(2) ' Hours
Sheets("Sheet2").Cells(11, 2).Offset(rowIndex, 3).Value = LineItem(3) ' Cost
Sheets("Sheet2").Cells(11, 2).Offset(rowIndex, 4).Value = LineItem(4) ' Description
rowIndex = rowIndex + 1
Loop
Close #1
End If
End Sub
The issues are as follows:-
Dates such as 02/06/2015 which are parsed and transposed to the excel cell will end up as 06/02/2015. This will not happen consistently, but happens randomly to various dates within the dataset.
CSV delimiter 4 will end up being parsed incorrectly where "" are in the data, as well as comma; Consequently the data is not transposed correctly to the relevant cell.
How can I go about correcting these errors?

Answer 1

Something like this should work for you:
Sub tgr()
Dim wb As Workbook
Dim wsDest As Worksheet
Dim sFilePath As String
Dim aData As Variant
sFilePath = Application.GetOpenFilename("CSV Files, *.csv", MultiSelect:=False)
If sFilePath = "False" Then Exit Sub 'Pressed cancel
Set wb = ActiveWorkbook
Set wsDest = wb.Sheets("Sheet2")
Application.ScreenUpdating = False
With Workbooks.Open(sFilePath)
aData = .Sheets(1).Range("A1", .Sheets(1).Cells(.Sheets(1).Rows.Count, "E").End(xlUp)).Value
.Close False
End With
Application.ScreenUpdating = True
With wsDest.Range("B11").Resize(UBound(aData, 1), UBound(aData, 2))
.Value = aData
.Resize(, 1).NumberFormat = "mm/dd/yyyy" 'Can set date format here, change to dd/mm/yyyy if needed
End With
End Sub

Answer 2

Most likely, the issue is a mismatch between the date format of your data and your Windows Regional Settings. Several ways to handle this
Change your Windows Regional Settings so they match
Change the file type to a *.txt file. Then use the Workbooks.OpenText method which allows you to specify the date column data type.
Create a Data Connection which will also allow you to do the same. Just be sure that you don't keep creating QueryTables. It the table is already there, either delete and recreate, or refresh.
Here is some code demonstrating the QueryTable method. In the Excel GUI this would be the Data ► Get External Data ► From text option
Option Explicit
Sub OpenCSV()
Dim filePath As String
Dim intChoice As Integer
Dim WS As Worksheet
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
intChoice = Application.FileDialog(msoFileDialogOpen).Show
If intChoice <> 0 Then
filePath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
Set WS = Worksheets("sheet2")
With WS.QueryTables
'If it exists, either delete and re-import or refresh
If .Count > 0 Then
Range(.Item(1).Destination.Address).CurrentRegion.Delete
.Item(1).Delete
End If
End With
'
With WS.QueryTables.Add(Connection:="TEXT;" & filePath, Destination:=WS.Range("$B$11"))
.Name = "New Text Document"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
'make sure format argument matches format in the csv file
.TextFileColumnDataTypes = Array(xlDMYFormat)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
End Sub

Answer 3

Dim arr() As String
Dim newDate As Date
arr = Split(LineItem(0), "/")
newDate = DateSerial(Year:=arr(2), Month:=arr(1), Day:=arr(0))
Then use
Sheets("Sheet2").Cells(11, 2).Offset(rowIndex, 0).Value = newDate