Vba 关于CSV文件转换为其他工作簿的查询

这是一个将CSV文件转换为表格excel文件的工作程序。我的问题是如何修改该文件，并命令程序将csv文件处理到另一个工作簿中。在下面的代码中，该代码将csv文件处理为Sheet2。多谢各位

Option Explicit

Sub ImportFile()
Dim sPath As String
Dim intChoice As Integer
Dim strPath As String
Dim FilePath As String

'change the display name of the open file dialog
Application.FileDialog(msoFileDialogOpen).Title = _
    "CSV File Opener"

'Remove all other filters
Call Application.FileDialog(msoFileDialogOpen).Filters.Clear

'Add a custom filter
Call Application.FileDialog(msoFileDialogOpen).Filters.Add( _
    "CSV Files Only", "*.csv")

'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False

'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show

If intChoice <> 0 Then

    'get the file path selected by the user
    strPath = Application.FileDialog( _
        msoFileDialogOpen).SelectedItems(1)

    Cells(7, 7) = strPath
Else
    MsgBox "Wrong CSV File. Please Choose Again"

End If
'Below we assume that the file, csvtest.csv,
'is in the same folder as the workbook. If
'you want something more flexible, you can
'use Application.GetOpenFilename to get a
'file open dialogue that returns the name
'of the selected file.
'On the page Fast text file import
'I show how to do that - just replace the
'file pattern "txt" with "csv".
sPath = strPath

'Procedure call. Semicolon is defined as separator,
'and data is to be inserted on "Sheet2".
'Of course you could also read the separator
'and sheet name from the worksheet or an input
'box. There are several options.
copyDataFromCsvFileToSheet sPath, ";", "Sheet2"

End Sub
'**************************************************************
Private Sub copyDataFromCsvFileToSheet(parFileName As String, _
parDelimiter As String, parSheetName As String)

Dim Data As Variant  'Array for the file values

'Function call - the file is read into the array
Data = getDataFromFile(parFileName, parDelimiter)

'If the array isn't empty it is inserted into
'the sheet in one swift operation.
If Not isArrayEmpty(Data) Then
  'If you want to operate directly on the array,
  'you can leave out the following lines.
  With Sheets(parSheetName)
    'Delete any old content
    .Cells.ClearContents
    'A range gets the same dimensions as the array
    'and the array values are inserted in one operation.
    .Cells(1, 1).Resize(UBound(Data, 1), UBound(Data, 2)) = Data
  End With
End If

End Sub

    Public Function isArrayEmpty(parArray As Variant) As Boolean
'Returns False if not an array or a dynamic array
'that hasn't been initialised (ReDim) or
'deleted (Erase).

If IsArray(parArray) = False Then isArrayEmpty = True
On Error Resume Next
If UBound(parArray) < LBound(parArray) Then
   isArrayEmpty = True
   Exit Function
Else
   isArrayEmpty = False
End If

End Function
'**************************************************************
Private Function getDataFromFile(parFileName As String, _
parDelimiter As String, _
Optional parExcludeCharacter As String = "") As Variant
'parFileName is the delimited file (csv, txt ...)
'parDelimiter is the separator, e.g. semicolon.
'The function returns an empty array, if the file
'is empty or cannot be opened.
'Number of columns is based on the line with most
'columns and not the first line.
'parExcludeCharacter: Some csv files have strings in
'quotations marks ("ABC"), and if parExcludeCharacter = """"
'quotation marks are removed.

Dim locLinesList() As Variant 'Array
Dim locData As Variant        'Array
Dim i As Long                 'Counter
Dim j As Long                 'Counter
Dim locNumRows As Long        'Nb of rows
Dim locNumCols As Long        'Nb of columns
Dim fso As Variant            'File system object
Dim ts As Variant             'File variable
Const REDIM_STEP = 10000      'Constant

'If this fails you need to reference Microsoft Scripting Runtime.
'You select this in "Tools" (VBA editor menu).
Set fso = CreateObject("Scripting.FileSystemObject")

On Error GoTo error_open_file
'Sets ts = the file
Set ts = fso.OpenTextFile(parFileName)
On Error GoTo unhandled_error

'Initialise the array
ReDim locLinesList(1 To 1) As Variant
i = 0
'Loops through the file, counts the number of lines (rows)
'and finds the highest number of columns.
Do While Not ts.AtEndOfStream
  'If the row number Mod 10000 = 0
  'we redimension the array.
  If i Mod REDIM_STEP = 0 Then
    ReDim Preserve locLinesList _
    (1 To UBound(locLinesList, 1) + REDIM_STEP) As Variant
  End If
  locLinesList(i + 1) = Split(ts.ReadLine, parDelimiter)
  j = UBound(locLinesList(i + 1), 1) 'Nb of columns in present row
  'If the number of columns is then highest so far.
  'the new number is saved.
  If locNumCols < j Then locNumCols = j
  i = i + 1
Loop

ts.Close 'Close file

locNumRows = i

'If number of rows is zero
If locNumRows = 0 Then Exit Function

ReDim locData(1 To locNumRows, 1 To locNumCols + 1) As Variant

'Copies the file values into an array.
'If parExcludeCharacter has a value,
'the characters are removed.
If parExcludeCharacter <> "" Then
  For i = 1 To locNumRows
    For j = 0 To UBound(locLinesList(i), 1)
      If Left(locLinesList(i)(j), 1) = parExcludeCharacter Then
        If Right(locLinesList(i)(j), 1) = parExcludeCharacter Then
          locLinesList(i)(j) = _
          Mid(locLinesList(i)(j), 2, Len(locLinesList(i)(j)) - 2)
        Else
          locLinesList(i)(j) = _
          Right(locLinesList(i)(j), Len(locLinesList(i)(j)) - 1)
        End If
      ElseIf Right(locLinesList(i)(j), 1) = parExcludeCharacter Then
        locLinesList(i)(j) = _
        Left(locLinesList(i)(j), Len(locLinesList(i)(j)) - 1)
      End If
      locData(i, j + 1) = locLinesList(i)(j)
    Next j
  Next i
Else
  For i = 1 To locNumRows
    For j = 0 To UBound(locLinesList(i), 1)
      locData(i, j + 1) = locLinesList(i)(j)
    Next j
  Next i
End If

getDataFromFile = locData

Exit Function

error_open_file:  'Returns empty Variant
unhandled_error:  'Returns empty Variant

End Function

选项显式
子导入文件（）
像细绳一样暗淡
选择整数
将strPath设置为字符串
将文件路径设置为字符串
'更改“打开文件”对话框的显示名称
Application.FileDialog（msoFileDialogOpen）。标题=_
“CSV文件开启器”
'删除所有其他筛选器
调用Application.FileDialog（msoFileDialogOpen）.Filters.Clear
'添加自定义筛选器
调用Application.FileDialog（msoFileDialogOpen）.Filters.Add（_
“仅限CSV文件”，“*.CSV”）
'仅允许用户选择一个文件
Application.FileDialog（msoFileDialogOpen）.AllowMultiSelect=False
'使文件对话框对用户可见
intChoice=Application.FileDialog（msoFileDialogOpen.Show）
如果选择0，那么
'获取用户选择的文件路径
strPath=Application.FileDialog（_
msoFileDialogOpen）。选择编辑项（1）
单元格（7，7）=strPath
其他的
MsgBox“错误的CSV文件。请重新选择”
如果结束
'下面我们假设文件csvtest.csv，
'与工作簿位于同一文件夹中。如果
“你想要更灵活的东西，你可以
'使用Application.GetOpenFilename获取
'返回名称的文件打开对话框
'所选文件的。
'在页面上快速导入文本文件
“我展示了如何做到这一点——只需更换
'文件模式“txt”与“csv”。
sPath=strPath
'程序调用。分号定义为分隔符，
，并将数据插入“表2”。
“当然，你也可以读分隔符
'和工作表或输入的工作表名称
“盒子。有几种选择。
copyDataFromCsvFileToSheet sPath，“；”，“Sheet2”
端接头
'**************************************************************
CSVFileToSheet的私有子copyDataFromCsvFileToSheet（文件名为字符串_
parDelimiter作为字符串，parSheetName作为字符串）
文件值的Dim Data As Variant数组
'函数调用-将文件读入数组
Data=getDataFromFile（parFileName，parDelimiter）
'如果数组不是空的，则将其插入
“在一次快速的操作中完成这张纸。
如果不是空的（数据），则
'如果要直接在阵列上操作，
“您可以省略以下几行。
带床单（parSheetName）
'删除任何旧内容
.Cells.ClearContents
'范围的维数与数组的维数相同
'并在一次操作中插入数组值。
.单元格（1，1）.调整大小（UBound（数据，1），UBound（数据，2））=数据
以
如果结束
端接头
公共函数isArrayEmpty（parArray作为变量）作为布尔值
'如果不是数组或动态数组，则返回False
“尚未初始化（ReDim）或
'已删除（删除）。
如果IsArray（parArray）=False，则isArrayEmpty=True
出错时继续下一步
如果UBound（parArray）'Procedure call. Semicolon is defined as separator,
'and data is to be inserted on "Sheet2".
'Of course you could also read the separator
'and sheet name from the worksheet or an input
'box. There are several options.

'create a workbook object
dim wb as workbook
'create a new workbook
set wb = workbooks.add
copyDataFromCsvFileToSheet sPath, ";", wb
set wb = nothing

End Sub
'**************************************************************
Private Sub copyDataFromCsvFileToSheet(parFileName As String, _
parDelimiter As String, wb as workbook)

Dim Data As Variant  'Array for the file values

'Function call - the file is read into the array
Data = getDataFromFile(parFileName, parDelimiter)

'If the array isn't empty it is inserted into
'the sheet in one swift operation.
If Not isArrayEmpty(Data) Then
  'If you want to operate directly on the array,
  'you can leave out the following lines.
  With wb.worksheets("Sheet1")
    'Delete any old content
    .Cells.ClearContents
    'A range gets the same dimensions as the array
    'and the array values are inserted in one operation.
    .Cells(1, 1).Resize(UBound(Data, 1), UBound(Data, 2)) = Data
    wb.saveas Filename:="whateveryouwant.xlsx"
  End With
End If



End Sub