Question

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

使用打开的文件对话框打开文件
将类型设置为分隔
将分隔符设置为逗号
将所有列设置为文本
自动调整所有列

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

Answer 1

以下代码允许用户浏览csv文件然后它会：

打开所选文件，将数据视为文本
调整列的大小
将数据移动到运行代码的工作簿中。

.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

Answer 2

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

Answer 3

在使用之前，我最终对该功能进行了一些调整。

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

感谢上述人让我前进。

在Excel 2007中自动执行文本导入

3 个答案: