Как импортировать данные CSV Excel для разделения ячеек с помощью VBA Excel 2010 msoFileDialogOpen

Question

Я пытаюсь использовать msoFileDialogOpen в VBA (используя Excel 2010) для импорта данных из файла. Макрос должен сделать его разделенным и разделенным запятой на импорт. Вот макрос:

Public Sub Function4_FileExplorer() 
Dim file As String 
' Start File Explorer to select file containing data (simple GUI, much easier than coding vFileName) 
On Error GoTo ErrorHandler 
With Application.FileDialog(msoFileDialogOpen) 
.AllowMultiSelect = False 
If .Show Then 
    file = .SelectedItems(1) 
    Workbooks.Open file ' there used to be Path.Open here but that doesn't work (since Path is a string) 
End If 
End With 
ErrorHandler: 
MsgBox "Error detected" & vbNewLine & "Error" & Err.Number & _ 
     Err.Description, vbCritical, "Error Handler: Error " & Err.Number 

End Sub 

Это свидетельствует о том, что вид файлов я пытаюсь отделить, 1 значение в ячейке (только файлы Excel, а не в блокноте):

http://blogs.technet.com/cfs-file.ashx/__key/CommunityServer-Blogs-Components-WeblogFiles/00-00-00-76-18-metablogapi/2055.HSG09091001_5F00_71EB0EE6.jpg

Answer 1

Это будет быть одним из способов:

Public Sub Function4_FileExplorer() 
Dim File As String, _ 
    Wb As Workbook, _ 
    Ws As Worksheet, _ 
    WsDest As Worksheet 

' Start File Explorer to select file containing data (simple GUI, much easier than coding vFileName) 
On Error GoTo ErrorHandler 
With Application.FileDialog(msoFileDialogOpen) 
    .AllowMultiSelect = False 
    If .Show Then 
     File = .SelectedItems(1) 
     Set Wb = Workbooks.Open(File) ' there used to be Path.Open here but that doesn't work (since Path is a string) 
    End If 
End With 

Set Ws = Wb.ActiveSheet 
'Or 
'Set Ws = Wb.Sheets("Sheet_Name_Here") 

Ws.Copy After:=Wb.Sheets(Wb.Sheets.Count) 
Set WsDest = Wb.ActiveSheet 

    WsDest.Range("A1:A" & WsDest.Range("A" & WsDest.Rows.Count).End(xlUp).Row).TextToColumns _ 
      Destination:=WsDest.Range("AA1"), _ 
      DataType:=xlDelimited, _ 
      TextQualifier:=xlDoubleQuote, _ 
      ConsecutiveDelimiter:=False, _ 
      Tab:=False, _ 
      Semicolon:=False, _ 
      Comma:=True, _ 
      Space:=False, _ 
      Other:=False, _ 
      FieldInfo:=Array(1, 1), _ 
      TrailingMinusNumbers:=True 

WsDest.Range("AA1").Activate 
GoTo SubCloser 
Exit Sub 

ErrorHandler: 
MsgBox "Error detected" & vbNewLine & "Error" & Err.Number & _ 
     Err.Description, vbCritical, "Error Handler: Error " & Err.Number 

SubCloser: 
Set Wb = Nothing 
Set Ws = Nothing 
Set WsDest = Nothing 

End Sub