Automate Text Import in Excel 2007
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 Wizard that comes up is r开发者_开发知识库un through the same way each time. The steps I need to take are:
- Open a file, using an open file dialog
- Set type to Delimited
- Set Delimiter to comma
- Set all columns to be imported as Text
- Auto fit all columns
I can't seem to wade through the documentation that shows how to do these things like open files. Even being able to start there would be helpful.
The code below will allow a user to browse for a csv file.
It will then :
- Open the selected file, treating the data as text
- Resize the columns
- Move the data into the workbook from which the code is run.
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.
精彩评论