使用Multiselect追加文本文件-VBA Excel

Question

我想在Excel VBA中編寫一些看起來很容易的東西，但最終讓我生氣了。

首先，我的蹩腳英語的藉口。這裏有個問題：

該程序的目標是使用multiselect函數在同一工作表中一個接一個地加載多個純文本文件。他們需要每個都低於另一個。我管理代碼逐個加載它們，但是我堅持使用MultiSelect。

該代碼附加文件，但一個接一個（讓我們說水平），而不是垂直，因爲我需要。這是我的代碼：

Private Sub Prova_Multiselect_Click() 
     Dim Fitxers As Variant 
     Dim Msg As String 
     Dim I As Integer 
     Dim destCell As Range 

     Set destCell = Worksheets("PEDREC").Cells(Rows.Count, "A").End(xlUp).Offset(1) 

     Fitxers = Application.GetOpenFilename(MultiSelect:=True, Title:="Choose txt files", FileFilter:="Text files *.txt (*.txt),") 

     If IsArray(Fitxers) Then 


      Set destCell = Worksheets("PEDREC").Cells(Rows.Count, "A").End(xlUp).Offset(1) 

      Msg = "Files selected:" & vbNewLine 

      For I = LBound(Fitxers) To UBound(Fitxers) 

      With destCell.Parent.QueryTables.Add(Connection:="TEXT;" & Fitxers(I), Destination:=destCell) 
       .TextFileStartRow = 1 
       .TextFileParseType = xlDelimited 
       .TextFileCommaDelimiter = True 
       .Refresh BackgroundQuery:=False 
      End With 

      Msg = Msg & Fitxers(I) & vbNewLine 

      Next I 

      MsgBox Msg 

     Else 
      MsgBox "No file selected." 
     End If 
End Sub 

我試過並搜索，但我找不到在同一列中追加所有文件的方式。任何幫助和想法都將受到歡迎！ ：D

在此先感謝！

Answer 1

當你在循環時，你並沒有前進destCell，而是永久卡在A2中。嘗試：

 For I = LBound(Fitxers) To UBound(Fitxers) 


     With destCell.Parent.QueryTables.Add(Connection:="TEXT;" & Fitxers(I), Destination:=destCell) 
      .TextFileStartRow = 1 
      .TextFileParseType = xlDelimited 
      .TextFileCommaDelimiter = True 
      .Refresh BackgroundQuery:=False 
     End With 

     Msg = Msg & Fitxers(I) & vbNewLine 

     Set destCell = destCell.Offset(1, 0) 


     Next I