vba 在 Excel 2007 中自动导入文本

Automate Text Import in Excel 2007

提问by Chris

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 run through the same way each time. The steps I need to take are:

我正在尝试使用 VBA 编写 Excel 宏来自动将 CSV 文本导入电子表格，但我以前从未这样做过。我需要确保每次都以相同的方式运行出现的文本导入向导。我需要采取的步骤是：

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

1. 使用打开文件对话框打开文件
2. 将类型设置为分隔
3. 将分隔符设置为逗号
4. 设置所有列作为文本导入
5. 自动适应所有列

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.

我似乎无法浏览显示如何执行这些操作（例如打开文件）的文档。即使能够从那里开始也会有所帮助。

采纳答案by Chris

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.

感谢上面的人让我前进。

回答by Robert Mearns

The code below will allow a user to browse for a csv file.
It will then :

下面的代码将允许用户浏览 csv 文件。
然后它将：

• 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.

.opentext 代码需要根据源数据中的列数进行更新。

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

回答by Oorang

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