請各位指點 以下是我之前錄製的VBA,按一次按鈕只能匯入一個TXT檔 ,該如何修改才能讓我按一次鍵匯入我所要的所有TXT檔至指定的SHEET中 謝謝

我的TXT檔名有 ICV.TXT CCV.TXT BK.TXT 20170627-C.TXT 20170627-CD.TXT
STD1.TXT STD2.TXT STD3.TXT STD4.TXT STD5.TXT
EXCEL的SHEET名稱 有 ICV CCV BK C CD CAB1 CAB2 CAB3 CAB4 CAB5 其中STD1~5 對應 CAB1~5 要由小到大依序匯入其它則對應名稱匯入 謝謝

Private Sub CommandButton1_Click()
 Dim strFilt As String
 Dim strTitle As String
 Dim strFname As Variant
 Dim i As Integer
 Dim strMsg As String

 strFilt = "文字檔案,*.txt,"
 strTitle = "打開Excel文件"
strFname = Application.GetOpenFilename(FileFilter:=strFilt, Title:=strTitle, MultiSelect:=True)
 If Not IsArray(strFname) Then
 MsgBox "沒選擇文件！"
Else
 For i = LBound(strFname) To UBound(strFname)
 strMsg = strMsg & strFname(i) & vbCrLf
 With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strFname(i), Destination:=Range("$A$5"))
 .Name = "C"
 .FieldNames = True
 .RowNumbers = False
 .FillAdjacentFormulas = False
 .PreserveFormatting = True
 .RefreshOnFileOpen = False
 .RefreshStyle = xlInsertDeleteCells
 .SavePassword = False
 .SaveData = True
 .AdjustColumnWidth = True
 .RefreshPeriod = 0
 .TextFilePromptOnRefresh = False
 .TextFilePlatform = 65001
 .TextFileStartRow = 1
 .TextFileParseType = xlDelimited
 .TextFileTextQualifier = xlTextQualifierDoubleQuote
 .TextFileConsecutiveDelimiter = True
 .TextFileTabDelimiter = True
 .TextFileSemicolonDelimiter = True
 .TextFileCommaDelimiter = True
 .TextFileSpaceDelimiter = True
 .TextFileOtherDelimiter = "\"
 .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
 .TextFileTrailingMinusNumbers = True
 .Refresh BackgroundQuery:=False
 End With
 ActiveWindow.SmallScroll Down:=33
 Cells.Select
 Selection.RowHeight = 10
 Selection.ColumnWidth = 5
 Rows("19:50").Select
 Selection.RowHeight = 0
 Rows("76:134").Select
 Selection.RowHeight = 0
 ActiveWindow.SmallScroll Down:=-69
 Columns("P:AS").Select
 Selection.ColumnWidth = 0
 ActiveWindow.ScrollColumn = 16
 ActiveWindow.ScrollColumn = 15
 ActiveWindow.ScrollColumn = 9
 ActiveWindow.ScrollColumn = 3![](http://)
 ActiveWindow.ScrollColumn = 1
 Range("K5").Select
 Selection.TextToColumns Destination:=Range("K5"), DataType:=xlFixedWidth, _
 FieldInfo:=Array(Array(0, 2), Array(9, 2), Array(11, 2)), TrailingMinusNumbers:= _
 True

 Next
 MsgBox "選擇的文件是：" & vbCrLf & strMsg
 End If

 End Sub