Автоматизировать импорт текста в Excel 2007

Question

Я пытаюсь написать макрос Excel, используя VBA для автоматизации импорта текста CSV в электронную таблицу, но я никогда не делал этого раньше.Мне нужно убедиться, что запускаемый Мастер импорта текста запускается одинаково каждый раз.Шаги, которые мне нужно сделать:

1. Открыть файл, используя диалог открытия файла
2. Установить тип с разделителями
3. Установить разделитель на запятую
4. Установить все столбцы для импорта в виде текста
5. Автоматически подогнать все столбцы

Я не могу просмотреть документацию, в которой показано, как делать такие вещи, как открытые файлы.Даже возможность начать там была бы полезна.

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

Спасибо вышеупомянутым парням за то, что они меня взяли.