I\'m trying to write an Excel macro using VBA to automate importing CSV text into a spreadsheet but I\'ve never done it before. I need to make sure that the Text Import Wiz
The code below will allow a user to browse for a csv file.
It will then :
The .opentext code needs to be updated depending on the number of columns in the source data.
Sub ImportCSV()
Dim vPath As Variant
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Set wb = Excel.ActiveWorkbook
Set ws = Excel.ActiveSheet
vPath = Application.GetOpenFilename("CSV (Comma Delimited) (*.csv),*.csv" _
, 1, "Select a file", , False)
''//Show the file open dialog to allow user to select a CSV file
If vPath = False Then Exit Sub
''//Exit macro if no file selected
Workbooks.OpenText Filename:=vPath, Origin:=xlMSDOS, StartRow:=1 _
, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Comma:=True _
, FieldInfo:=Array(Array(1, xlTextFormat), Array(2, xlTextFormat), _
Array(3, xlTextFormat))
''//The fieldinfo array needs to be extended to match your number of columns
Columns.EntireColumn.AutoFit
''//Resize the columns
Sheets(1).Move Before:=wb.Sheets(1)
''//Move the data into the Workbook
End Sub
Public Sub Example()
Const csPath As String = "C:\Test\Example.csv"
Dim ws As Excel.Worksheet
Set ws = Excel.ActiveSheet
With ws.QueryTables.Add("TEXT;" & csPath, ws.Cells(1, 1))
.FieldNames = True
.AdjustColumnWidth = True
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileCommaDelimiter = True
''// This array will need as many entries as there will be columns:
.TextFileColumnDataTypes = Array(xlTextFormat, xlTextFormat)
.Refresh
End With
End Sub
I ended up making some tweaks to the function before putting it into use.
Public Sub OpenCsv()
' I don't expect any more columns than 256 in my environment, so I can
' just fill this array and call it done.
Dim columnFormats(0 To 255) As Integer
For i = 0 To 255
columnFormats(i) = xlTextFormat
Next i
Dim filename As Variant
filename = Application.GetOpenFilename("All Files (*.*),*.*", 1, "Open", "", False)
' If user clicks Cancel, stop.
If (filename = False) Then
Exit Sub
End If
Dim ws As Excel.Worksheet
Application.Workbooks.Add
Set ws = Excel.ActiveSheet
Application.DisplayAlerts = False
Sheets("Sheet2").Delete
Sheets("Sheet3").Delete
Application.DisplayAlerts = True
With ws.QueryTables.Add("TEXT;" & filename, ws.Cells(1, 1))
.FieldNames = True
.AdjustColumnWidth = True
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileCommaDelimiter = True
''// This array will need as many entries as there will be columns:
.TextFileColumnDataTypes = columnFormats
.Refresh
End With
End Sub
Thanks to the above guys for getting me going.