VBA将多个txt批量转换成excel表并保存

Sub ykcbf() Set fso = CreateObject("scripting.filesystemobject")Application.ScreenUpdating = FalseApplication.DisplayAlerts = Falsep = ThisWorkbook.Path & ""On Error Resume NextFor Each f In fso.GetFolder(p).FilesIf f.Name Like "*.txt" Thenfn = fso.GetBaseName(f)zrr = Split(ReadUTFText(f), Chr(13))ReDim brr(1 To 1000, 1 To 6)m = 0For i = 0 To UBound(zrr)If zrr(i) <> Empty Thens = WorksheetFunction.Trim(zrr(i))b = Split(s, ",")m = m + 1brr(m, 1) = b(0)brr(m, 3) = b(4)brr(m, 4) = b(1)brr(m, 5) = fnbrr(m, 6) = b(2)End IfNextApplication.SheetsInNewWorkbook = 1Set wb = Workbooks.AddWith wb.Sheets(1).Columns(4).NumberFormatLocal = "@".[a1:f1] = Array("姓名", "电话", "省份", "身份证号", "住址", "民族").[a2].Resize(m, 6) = brrWith .[a1].Resize(m + 1, 6).Borders.LineStyle = 1.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.EntireColumn.AutoFitEnd With.SaveAs p & fn.Close 1End WithEnd IfNext fApplication.ScreenUpdating = TrueMsgBox "OK！"
End Sub