Excel批量一次性处理xls文件VBA制盘TXT①

Sub 批量一次处理全部Excel文件() '批量一次
Dim wb As Workbook
Dim ws As Worksheet
Dim lngRow          As Long
Dim lngCol          As Long
Dim strContent      As String
Dim EndRow As Single
Dim i&, j&, k&, m$, l$
Dim fn, fp
fp = ThisWorkbook.Path & "\1待处理文件\"
fn = Dir(fp & "*.xl*")
Application.DisplayAlerts = False
Application.ScreenUpdating = True
On Error Resume Next
Do While fn <> ""
Set wb = Workbooks.Open(fp & fn)
For Each ws In wb.Worksheets
With ws
On Error Resume Next
 ActiveWorkbook.Sheets(1).Range("A:D").Copy
ThisWorkbook.Sheets(17).Range("A:D").PasteSpecial Paste:=xlPasteValues
For i = 250 To 1 Step -1
 If ThisWorkbook.Sheets(17).Cells(i, 4).Text Like "0" Or ThisWorkbook.Sheets(17).Cells(i, 4).Text Like "" Then
 Cells(i, 4).EntireRow.Delete
 End If
Next
For i = 250 To 1 Step -1'此处是行数250 根据需要设定 可再引入其他计数 但出于防止逻辑错误 直接根据项目设置合理行数
 If ThisWorkbook.Sheets(17).Cells(i, 3).Text Like "62*" Or ThisWorkbook.Sheets(17).Cells(i, 3).Text Like "8001000*" Then
 Else
 Cells(i, 3).EntireRow.Delete
 End If
 Next
ThisWorkbook.Sheets(17).Columns("D:D").NumberFormatLocal = "G/通用格式"
ThisWorkbook.Sheets(17).Columns("A:D").Select
Selection.Replace What:=" ", Replacement:=""
j = Application.WorksheetFunction.Count(ThisWorkbook.Sheets(17).[D:D])
For k = 1 To j
Cells(k, 1) = k
Next k
ActiveWorkbook.Sheets(1).Range("A1").Copy
ThisWorkbook.Sheets(17).Range("I1").PasteSpecial Paste:=xlPasteValues
Selection.Paste
ThisWorkbook.Sheets(17).Range("I1").Select
ThisWorkbook.Sheets(17).Range("I1").Replace What:=" ", Replacement:=""
ThisWorkbook.Sheets(17).Range("I1").Replace What:="要替换的文", Replacement:=""
l = ThisWorkbook.Sheets(17).Shapes.Range(Array("TextBox 1")).TextFrame.Characters.Caption
Open ThisWorkbook.Path & "\2TXT\" & ThisWorkbook.Sheets(17).Range("I1").Text & ".txt" For Output As #1
m = Application.WorksheetFunction.Count(ThisWorkbook.Sheets(17).[A:A])
For lngRow = 1 To m - 1
strContent = ThisWorkbook.Sheets(17).Cells(lngRow, 1).Text & "|" & ThisWorkbook.Sheets(17).Cells(lngRow, 2).Text & "|" & ThisWorkbook.Sheets(17).Cells(lngRow, 3).Text & "|" & ThisWorkbook.Sheets(17).Cells(lngRow, 4).Text
strContent = strContent & vbCrLf
Print #1, strContent;
Next
strContent = ThisWorkbook.Sheets(17).Cells(m, 1).Text & "|" & ThisWorkbook.Sheets(17).Cells(m, 2).Text & "|" & ThisWorkbook.Sheets(17).Cells(m, 3).Text & "|" & ThisWorkbook.Sheets(17).Cells(m, 4).Text
Print #1, strContent;
Close #1
End With
Next ws
wb.Close savechanges:=False
fn = Dir()
Loop
Application.DisplayAlerts = True
ThisWorkbook.Sheets(17).Shapes.Range(Array("TextBox 1")).Select
Selection.Text = ThisWorkbook.Sheets(17).Range("I1").Text
ThisWorkbook.Sheets(17).Range("I1").Select
Selection.ClearContents
End Sub