Drop time info from CSV import

[farmdwg]

I'm a bit of a new person to this VBA stuff so I thought I'd ask. One of the CSVs that I'm importing has a date format of YYYY-MM-DD 00:00:00. I'd like to drop the 00:00:00 if possible without modifying the CSV beforehand.

date.PNG

This is my VBA to date:

Private Sub Workbook_Open()
    RefreshLinks
End Sub
Sub RefreshLinks()
    On Error Resume Next
    For Each c In ThisWorkbook.Connections
        c.Delete
    Next
    
    MakeLink ThisWorkbook.Path & "\" & "attachments.csv", "Data", "Data!A2", 1
    MakeLink ThisWorkbook.Path & "\" & "msg_adv.csv", "Data", "Data!G2", 1
    MakeLink ThisWorkbook.Path & "\" & "msg_by_weeks.csv", "Data", "Data!M2", 1
    MakeLink ThisWorkbook.Path & "\" & "outbound_attachments.csv", "Data", "Data!Q2", 1
    MakeLink ThisWorkbook.Path & "\" & "outbound_msg_adv.csv", "Data", "Data!W2", 1
    MakeLink ThisWorkbook.Path & "\" & "outbound_msg_by_months.csv", "Data", "Data!AC2", 1
    MakeLink ThisWorkbook.Path & "\" & "pcsc.txt", "Data", "Data!AG2", 1
    MakeLink ThisWorkbook.Path & "\" & "pdrv2_adv.csv", "Data", "Data!AP2", 1
    MakeLink ThisWorkbook.Path & "\" & "pdrv2_by_months.csv", "Data", "Data!AU2", 1
    MakeLink ThisWorkbook.Path & "\" & "regulation_adv.csv", "Data", "Data!AZ2", 1
    MakeLink ThisWorkbook.Path & "\" & "spam_adv.csv", "Data", "Data!BF2", 1
    MakeLink ThisWorkbook.Path & "\" & "stats_by_months.csv", "Data", "Data!BN2", 1
    MakeLink ThisWorkbook.Path & "\" & "TAPReport.csv", "Data", "Data!BT2", 1
    MakeLink ThisWorkbook.Path & "\" & "top_virus.csv", "Data", "Data!CD2", 1
    MakeLink ThisWorkbook.Path & "\" & "virus_adv.csv", "Data", "Data!CH2", 1
    MakeLink ThisWorkbook.Path & "\" & "virus_by_months.csv", "Data", "Data!CM2", 1
         
End Sub
Sub MakeLink(strFileName As String, strSheetName As String, strRangeAddress As String, startRow As Long)


    With Sheets(strSheetName).QueryTables.Add(Connection:="TEXT;" & strFileName, _
        Destination:=Range(strRangeAddress))
        .Name = "ABC"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = startRow
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Is there any edits to my code that would drop the time?

Thanks!

[werafa]

you have two options.
1: you can set the cell format to effectively hide the time data
2: you can convert the value to an integer - Excel stores day/month/year as integer values, and hours, minutes and seconds as values of less than 1 (decimal places)

Werafa

[farmdwg]

thanks for the feedback. unfortunately, after I import my data, there is something funny going on with the cell formats. I can try changing them to a different format but nothing works. even basic formulas like SUM do not work. I've only been able to get the format to work after I select the column, click on Text to Columns and then set the date format. Could it be something wrong with my import code?

[farmdwg]

I'm guessing it is something to do with:

Sub MakeLink(strFileName As String, strSheetName As String, strRangeAddress As String, startRow As Long)


    With Sheets(strSheetName).QueryTables.Add(Connection:="TEXT;" & strFileName, _
        Destination:=Range(strRangeAddress))
        .Name = "ABC"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = startRow
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

[p45cal]

Give us a sample .csv file that this happens with.

[farmdwg]

It won't let me post a link to my file. I keep on getting this error.

"Post denied. New posts are limited by number of URLs it may contain and checked if it doesn't contain forbidden words."

[farmdwg]

regulation_adv.csv

Perhaps this will work.

[werafa]

the data is imported as a text string, and contains additional characters.
it can not be recognised as date data type.

so,

myRow = 2
do while myrow <> ""
   myDate = mySheet.range("A" & myRow).value
   mydate = left(mydate,10)
   mydate = cdate(mydate)
   mysheet.range("B" & myRow) = mydate
   myrow = myrow +1
loop

try "Dim myDate as variant" to allow the data type to change, otherwise, dim mydate as date, and add myString as string to manage the extraction of the date string

werafa

[werafa]

this will read the date component of your text string,
convert it to date format
and write the new date data to column b

and loop from row 2 until you hit an empty row

[farmdwg]

Thank you for the input. Can I just add this to the Sub statement before the End Sub?

This is my entire VBA code.

Private Sub Workbook_Open()
    RefreshLinks
End Sub
Sub RefreshLinks()
    On Error Resume Next
    For Each c In ThisWorkbook.Connections
        c.Delete
    Next
    
    MakeLink ThisWorkbook.Path & "\" & "attachments.csv", "Data", "Data!A2", 1
    MakeLink ThisWorkbook.Path & "\" & "msg_adv.csv", "Data", "Data!G2", 1
    MakeLink ThisWorkbook.Path & "\" & "msg_by_weeks.csv", "Data", "Data!O2", 1
    MakeLink ThisWorkbook.Path & "\" & "outbound_attachments.csv", "Data", "Data!T2", 1
    MakeLink ThisWorkbook.Path & "\" & "outbound_msg_adv.csv", "Data", "Data!Z2", 1
    MakeLink ThisWorkbook.Path & "\" & "outbound_msg_by_months.csv", "Data", "Data!AH2", 1
    MakeLink ThisWorkbook.Path & "\" & "pcsc.txt", "Data", "Data!AL2", 1
    MakeLink ThisWorkbook.Path & "\" & "pdrv2_adv.csv", "Data", "Data!AU2", 1
    MakeLink ThisWorkbook.Path & "\" & "pdrv2_by_months.csv", "Data", "Data!AZ2", 1
    MakeLink ThisWorkbook.Path & "\" & "regulation_adv.csv", "Data", "Data!BE2", 1
    MakeLink ThisWorkbook.Path & "\" & "spam_adv.csv", "Data", "Data!BK2", 1
    MakeLink ThisWorkbook.Path & "\" & "stats_by_months.csv", "Data", "Data!BT2", 1
    MakeLink ThisWorkbook.Path & "\" & "TAPReport.csv", "Data", "Data!BZ2", 1
    MakeLink ThisWorkbook.Path & "\" & "top_virus.csv", "Data", "Data!CJ2", 1
    MakeLink ThisWorkbook.Path & "\" & "virus_adv.csv", "Data", "Data!CN2", 1
    MakeLink ThisWorkbook.Path & "\" & "virus_by_months.csv", "Data", "Data!CS2", 1
         
End Sub
Sub MakeLink(strFileName As String, strSheetName As String, strRangeAddress As String, startRow As Long)




    With Sheets(strSheetName).QueryTables.Add(Connection:="TEXT;" & strFileName, _
        Destination:=Range(strRangeAddress))
        .Name = "ABC"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = startRow
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With


End Sub

[p45cal]

Your csv file contains date and time info in the first column.
Currently, the line:
.TextFileColumnDataTypes = Array(2)
brings that data in as just text and the cells are formatted as text too.

The dates in the csv file are in Year/month/day format so we need to tell Excel that with
.TextFileColumnDataTypes = Array(5)
where the 5 (xlYMDFormat) is telling Excel to assume the data coming into the first column is in that format. This results in the text being converted to real Excel dates (and times) and also results in Excel formatting the cells to a date format (actually a Date and time format (Excel being heplful)). Now you need only to change that format to one of your liking (the .ResultRange.Columns(1).NumberFormat line towards the end below)

Try this (many commented-out rows are the defaults anyway, so you don't need them):

Sub MakeLink(strFileName As String, strSheetName As String, strRangeAddress As String, startRow As Long)
With Sheets(strSheetName).QueryTables.Add(Connection:="TEXT;" & strFileName, Destination:=Range(strRangeAddress))
  '.Name = "ABC" 'no need to name every query the same (unless you're going to use them)!
  '.FieldNames = True'default
  '.RowNumbers = False 'default
  '.FillAdjacentFormulas = False 'default
  '.PreserveFormatting = True 'default
  '.RefreshOnFileOpen = False 'default
  .RefreshStyle = xlOverwriteCells
  '.SavePassword = False 'default
  '.SaveData = True 'default
  '.AdjustColumnWidth = True 'default
  '.RefreshPeriod = 0 'default
  '.TextFilePromptOnRefresh = False 'default
  .TextFilePlatform = 437
  .TextFileStartRow = startRow
  .TextFileParseType = xlDelimited
  .TextFileTextQualifier = xlTextQualifierDoubleQuote
  .TextFileConsecutiveDelimiter = False
  .TextFileTabDelimiter = True
  .TextFileSemicolonDelimiter = False
  .TextFileCommaDelimiter = True
  .TextFileSpaceDelimiter = False
  '.TextFileColumnDataTypes = Array(2)
  .TextFileColumnDataTypes = Array(5)
  .TextFileTrailingMinusNumbers = True
  .Refresh BackgroundQuery:=False
  .ResultRange.Columns(1).NumberFormat = "m/d/yyyy" 'or however you want it.
End With
End Sub

Now the only worry is:

One of the CSVs that I'm importing has a date format of YYYY-MM-DD 00:00:00.

Only one? Do the others have something different in the first column? If so we'll have to treat just that one differently. Easy enough since you're passing a bunch of arguments with each call so we could add one or two being the format of the csv file's first column and how you want that column formatted in your sheet afterwards.

[werafa]

re the 'can I add this to the exisiting sub' question,

you will find it much easier to manage code if you have a bunch of small routines, call them as needed, and pass info between them.
if a sub has a small number of defined inputs, and has one single output or task, it is relatively simple to check it for correct operation.
run a master control sub to string things together, or call one sub-routine from within another.

so, for my earlier piece of code, create an additional sub that writes the range to a worksheet, or a function that returns an array of corrected dates. A handy rule of thumb is that a sub should be short enough to be visible on screen without scrolling.

Re P45's approach, this stops the problem from occurring rather than fixing it post-hoc - and so is probably better
Werafa

[farmdwg]

Thank you for your help here. This gets me very close to getting all my data imported.

[farmdwg]

Yeah, I was about to comment. I do have some CSVs that have different data types in the first column. In fact I have 3 CSVs that have something different in column 1. Thoughts?

[werafa]

break the job up into discrete tasks.
get your data into excel, then look at it, and see what needs to be done to it

write each of these steps as separate sub-routines - and reuse as required

[p45cal]

Yeah, I was about to comment. I do have some CSVs that have different data types in the first column. In fact I have 3 CSVs that have something different in column 1. Thoughts?

Sub MakeLink(strFileName As String, strSheetName As String, strRangeAddress As String, startRow As Long, FirstColmcsvFormat, FirstColmSheetFormat)
[You could even make the last parameters optional, so that they take on a default value if not supplied]
in that sub:
.TextFileColumnDataTypes = FirstColmcsvFormat
.ResultRange.Columns(1).NumberFormat = FirstColmSheetFormat

Called by:
MakeLink ThisWorkbook.Path & "\" & "regulation_adv.csv", "Data", "Data!AZ2", 1, Array(5), "m/d/yyyy"

The Array(5) can actually be more columns defined: Array(5,1,1,1) etc.
Currently Columns(1).NumberFormat only affects column 1, but that 1 could be any column and passed as an argument. You're only limited by your imagination.

[farmdwg]

I might be missing something but I'm getting an error with your suggestions.

error.jpg
Thanks!

[p45cal]

The makeLink sub needs 2 more arguments every time it's called. You only have one line with enough arguments. The rest need the original value that was in the MakeLink sub itself, that is:
,Array(2),"@"
which brings in the data as Text and formats the cells as Text, so tack those two extra arguments on the end of each of the calls which don't already have them.
I don't have time to write a sub to make those arguments optional just now.

BTW, your pictures don't have a high enough resolution to make out what in them.

[farmdwg]

Thanks.

Private Sub Workbook_Open()
    RefreshLinks
End Sub
Sub RefreshLinks()
    On Error Resume Next
    For Each c In ThisWorkbook.Connections
        c.Delete
    Next
    
    MakeLink ThisWorkbook.Path & "\" & "attachments.csv", "Data", "Data!A2", 1
    MakeLink ThisWorkbook.Path & "\" & "msg_adv.csv", "Data", "Data!G2", 1
    MakeLink ThisWorkbook.Path & "\" & "msg_by_weeks.csv", "Data", "Data!O2", 1
    MakeLink ThisWorkbook.Path & "\" & "outbound_attachments.csv", "Data", "Data!T2", 1
    MakeLink ThisWorkbook.Path & "\" & "outbound_msg_adv.csv", "Data", "Data!Z2", 1
    MakeLink ThisWorkbook.Path & "\" & "outbound_msg_by_months.csv", "Data", "Data!AH2", 1
    MakeLink ThisWorkbook.Path & "\" & "pcsc.txt", "Data", "Data!AL2", 1
    MakeLink ThisWorkbook.Path & "\" & "pdrv2_adv.csv", "Data", "Data!AU2", 1
    MakeLink ThisWorkbook.Path & "\" & "pdrv2_by_months.csv", "Data", "Data!AZ2", 1
    MakeLink ThisWorkbook.Path & "\" & "regulation_adv.csv", "Data", "Data!BE2", 1, Array(5), "m/d/yyyy"
    MakeLink ThisWorkbook.Path & "\" & "spam_adv.csv", "Data", "Data!BK2", 1
    MakeLink ThisWorkbook.Path & "\" & "stats_by_months.csv", "Data", "Data!BT2", 1
    MakeLink ThisWorkbook.Path & "\" & "TAPReport.csv", "Data", "Data!BZ2", 1
    MakeLink ThisWorkbook.Path & "\" & "top_virus.csv", "Data", "Data!CJ2", 1
    MakeLink ThisWorkbook.Path & "\" & "virus_adv.csv", "Data", "Data!CN2", 1
    MakeLink ThisWorkbook.Path & "\" & "virus_by_months.csv", "Data", "Data!CS2", 1
         
End Sub
Sub MakeLink(strFileName As String, strSheetName As String, strRangeAddress As String, startRow As Long, FirstColmcsvFormat)
    With Sheets(strSheetName).QueryTables.Add(Connection:="TEXT;" & strFileName, Destination:=Range(strRangeAddress))
         '.Name = "ABC" 'no need to name every query the same (unless you're going to use them)!
         '.FieldNames = True'default
         '.RowNumbers = False 'default
         '.FillAdjacentFormulas = False 'default
         '.PreserveFormatting = True 'default
         '.RefreshOnFileOpen = False 'default
        .RefreshStyle = xlOverwriteCells
         '.SavePassword = False 'default
         '.SaveData = True 'default
         '.AdjustColumnWidth = True 'default
         '.RefreshPeriod = 0 'default
         '.TextFilePromptOnRefresh = False 'default
        .TextFilePlatform = 437
        .TextFileStartRow = startRow
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        '.TextFileColumnDataTypes = Array(2)
        '.TextFileColumnDataTypes = Array(5)
        .TextFileColumnDataTypes = FirstColmcsvFormat
        .ResultRange.Columns(1).NumberFormat = FirstColmSheetFormat
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        '.ResultRange.Columns(1).NumberFormat = "m/d/yyyy" 'or however you want it.
    End With
End Sub

[p45cal]

Private Sub Workbook_Open()
    RefreshLinks
End Sub
Sub RefreshLinks()
    On Error Resume Next
    For Each c In ThisWorkbook.Connections
        c.Delete
    Next
    
    MakeLink ThisWorkbook.Path & "\" & "attachments.csv", "Data", "Data!A2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "msg_adv.csv", "Data", "Data!G2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "msg_by_weeks.csv", "Data", "Data!O2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "outbound_attachments.csv", "Data", "Data!T2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "outbound_msg_adv.csv", "Data", "Data!Z2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "outbound_msg_by_months.csv", "Data", "Data!AH2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "pcsc.txt", "Data", "Data!AL2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "pdrv2_adv.csv", "Data", "Data!AU2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "pdrv2_by_months.csv", "Data", "Data!AZ2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "regulation_adv.csv", "Data", "Data!BE2", 1, Array(5), "m/d/yyyy"
    MakeLink ThisWorkbook.Path & "\" & "spam_adv.csv", "Data", "Data!BK2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "stats_by_months.csv", "Data", "Data!BT2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "TAPReport.csv", "Data", "Data!BZ2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "top_virus.csv", "Data", "Data!CJ2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "virus_adv.csv", "Data", "Data!CN2", 1, Array(2), "@"
    MakeLink ThisWorkbook.Path & "\" & "virus_by_months.csv", "Data", "Data!CS2", 1, Array(2), "@"
         
End Sub
Sub MakeLink(strFileName As String, strSheetName As String, strRangeAddress As String, startRow As Long, FirstColmcsvFormat, FirstColmSheetFormat)
    With Sheets(strSheetName).QueryTables.Add(Connection:="TEXT;" & strFileName, Destination:=Range(strRangeAddress))
         '.Name = "ABC" 'no need to name every query the same (unless you're going to use them)!
         '.FieldNames = True'default
         '.RowNumbers = False 'default
         '.FillAdjacentFormulas = False 'default
         '.PreserveFormatting = True 'default
         '.RefreshOnFileOpen = False 'default
        .RefreshStyle = xlOverwriteCells
         '.SavePassword = False 'default
         '.SaveData = True 'default
         '.AdjustColumnWidth = True 'default
         '.RefreshPeriod = 0 'default
         '.TextFilePromptOnRefresh = False 'default
        .TextFilePlatform = 437
        .TextFileStartRow = startRow
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        '.TextFileColumnDataTypes = Array(2)
        '.TextFileColumnDataTypes = Array(5)
        .TextFileColumnDataTypes = FirstColmcsvFormat
        .ResultRange.Columns(1).NumberFormat = FirstColmSheetFormat
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        '.ResultRange.Columns(1).NumberFormat = "m/d/yyyy" 'or however you want it.
    End With
End Sub

I can't test just now so just edited your quoted code.