开发者

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:

  1. Open a file, using an open file dialog
  2. Set type to Delimited
  3. Set Delimiter to comma
  4. Set all columns to be imported as Text
  5. 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.

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜