使用VBA在Excel中加载多个逗号分隔文本的问题

早上好，

我想加载多个逗号分层的casv样式文件与.plt扩展在Excel中。

我正在做的是加载openfolder对话框，并select保存我的代码与第一位代码的文件夹并粘贴到TextBox1的path。 我已经成功地做到了这一点。 然后，我试图用运行button来运行更多的代码，以将新文件名中的所有文件加载到工作表中作为工作表名称。 但是我正在努力处理以下两件事情：

1. 当我尝试在新的工作簿中打开文件时，每个文件都在新的工作簿中打开，但是我希望他们仅用不同的工作表中的每个文件打开一个新的工作簿。

2. 该程序工作正常，当我手动分配目录path，但当我要求程序读取文件夹path的文本保存从文本框失败

有人请给我一些build议，如何纠正这一点，非常感谢。 我的代码如下：

我已经在可能的地方添加了评论，我认为我做了一些错误的操作，通过用文件pathsich手动replace注释部分“C：\ Users \ Desktop \ test \”程序正常工作，可以在同一个工作簿中加载所有文件。

'Code for the button on the right of textbox 1 Private Sub FilePath_Button_Click() get_folder End Sub ' code for the run button Private Sub Run_Button_Click() load_file End Sub Private Sub TextBox1_Change() End Sub Private Sub UserForm_Click() End Sub 'code for the fild open dialouge box to locate folder where the files are saved Public Sub get_folder() Dim FolderName As String With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Show On Error Resume Next FolderName = .SelectedItems(1) Err.Clear On Error GoTo 0 End With TextBox1.Text = FolderName End Sub 'codes for the run button to import the files Sub load_file() Dim strFile As String Dim ws As Worksheet strFile = Dir("TextBox1.Text*.plt") ' I think this is the bit where I doing something wrong Do While strFile <> vbNullString Set ws = Sheets.Add With ws.QueryTables.Add(Connection:= _ "TEXT;" & "TextBox1.Text" & strFile, Destination:=Range("$A$1")) ' and also "TextBox1.Text" I think not right as if i replace this two section that I commented with the file path manually the program works fine .Name = strFile .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With strFile = Dir Loop End Sub 

Answer 1

尝试更换：

 strFile = Dir("TextBox1.Text*.csv") ' I think this is the bit where I doing something wrong Do While strFile <> vbNullString Set ws = Sheets.Add 

同

 StrFile = Dir(Me.TextBox1.Text & "\*.csv") Do While Len(StrFile) > 0 Set ws = ActiveWorkbook.Sheets.Add ws.Name = StrFile 

编辑

将.csv文件添加到新的工作簿

 Dim wb as workbook Do While Len(StrFile) > 0 Set wb = Workbooks.Add 'added workbook becomes the activeworkbook Set ws = ActiveWorkbook.Sheets.Add ws.Name = StrFile 

Answer 2

是否有任何理由使用QueryTable？ 只要打开工作簿并复制工作表就足够了，因为CSV文件已经具有工作表名称作为文件名。

尝试用这个replaceload_file()过程：

 Sub load_file() Dim wb1 As Workbook, wb2 As Workbook Dim filePath As String, strFile As String Application.ScreenUpdating = False Set wb1 = ActiveWorkbook filePath = TextBox1.Text strFile = Dir(filePath) While Not strFile = "" If LCase(Right(strFile, 4)) = ".plt" Then Set wb2 = Workbooks.OpenText(Filepath:=fileName & "\" & strFile, Datatype:=xlDelimited, Comma:=True) '// open the workbook wb2.Sheets(1).Copy after:=wb1.Sheets(wb1.Sheets.Count) '// copy the page to wb1 wb2.Close False '// close wb2 Set wb2 = Nothing '// release from memory End If strFile = Dir() Wend Set wb1 = Nothing Application.ScreenUpdating = True MsgBox "Done" End Sub