PDA

View Full Version : Drop time info from CSV import



farmdwg
02-22-2017, 08:43 PM
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.

18451

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
02-23-2017, 02:25 AM
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
02-23-2017, 08:47 AM
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
02-23-2017, 08:55 AM
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
02-23-2017, 12:24 PM
Give us a sample .csv file that this happens with.

farmdwg
02-23-2017, 01:34 PM
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
02-23-2017, 01:35 PM
18460

Perhaps this will work.

werafa
02-23-2017, 03:14 PM
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
02-23-2017, 03:19 PM
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
02-23-2017, 03:29 PM
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
02-23-2017, 04:35 PM
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
02-23-2017, 05:00 PM
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
02-23-2017, 05:04 PM
Thank you for your help here. This gets me very close to getting all my data imported.

farmdwg
02-23-2017, 05:24 PM
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
02-23-2017, 06:34 PM
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
02-23-2017, 07:17 PM
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
02-24-2017, 09:32 AM
I might be missing something but I'm getting an error with your suggestions.

18465
Thanks!

p45cal
02-24-2017, 10:14 AM
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
02-24-2017, 10:21 AM
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
02-24-2017, 11:26 AM
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 SubI can't test just now so just edited your quoted code.

farmdwg
02-24-2017, 11:43 AM
Thank you, but nothing is importing now. Not sure..

p45cal
02-24-2017, 12:49 PM
.resultrange…
must come after:
.Refresh…
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
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
.ResultRange.Columns(1).NumberFormat = FirstColmSheetFormat
'.ResultRange.Columns(1).NumberFormat = "m/d/yyyy" 'or however you want it.
End With
End Sub

farmdwg
02-24-2017, 03:33 PM
Yhatzee!!