Sub test()
Dim fs$, ar, fn$, br(1 To 10000, 1 To 7), t
Dim c, i&, j&, r&, ph$
c = Array(0, 0, 1, 2, 3, 4, 5, 7)
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = "*.txt"
.Show
If .SelectedItems.Count > 0 Then
fs = .SelectedItems(1)
Else
MsgBox "沒有選取檔案 !!!"
Exit Sub
End If
End With
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = " +(?!$)"
While Len(fn) > 0
Open ph & fn For Input As #1
ar = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Reset
For i = 4 To UBound(ar) - 1
r = r + 1
ar(i) = .Replace(ar(i), "|")
t = Split(ar(i), "|")
For j = 1 To UBound(c)
br(r, j) = t(c(j))
Next
br(r, 2) = Mid(fn, 6, 8)
Next
fn = Dir
Wend
End With
With Sheet1
.Range("2:" & Rows.Count).ClearContents
.Range("a:a").NumberFormatLocal = "@"
.[a2].Resize(r, UBound(br, 2)) = br
End With
End Sub