Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application") '創建EXCEL對象
Set xlBook = xlApp.Workbooks.Add
xlApp.Visible = False '設置EXCEL對象可見（或不可見）
Set xlSheet = xlBook.Worksheets("sheet1")
For i = 0 To List1.ListCount - 1 '這部分妳不用看了
filename = List1.List(i)
Open filename For Input As #1
Do While Not EOF(1)
Line Input #1, tempInput
If InStr(tempInput, "at") <> 0 Then
c() = Split(tempInput, " ")
For k = 0 To UBound(c())
xlSheet.Cells(j + 1, k + 1) = c(k) 'c(k）賦給表格j+1行k+1列，妳說的寫第二組數據可以用循環
Next
ReDim c(10)
Else
For k = 0 To 10
c(k) = Trim(Mid(tempInput, p + 1, 7))
p = p + 7
Next
For k = 0 To 10
xlSheet.Cells(j + 1, k + 1) = c(k)
Next
p = 0
End If
j = j + 1
Loop
Close #1
filename = Replace(filename, "txt", "xls")
xlBook.SaveAs (filename) '保存excel
Me.Caption = filename & "轉換完畢！" & "已完成" & i + 1 & "/" & List1.ListCount
j = 0
k = 0
Next
xlBook.Close (True) '關閉工作簿
xlApp.Quit '結束EXCEL對象
Set xlApp = Nothing '釋放xlApp對象
Me.Caption = "所有xls轉換完畢！"
MsgBox ("轉換完成！")