Не могу понять почему ошибка?
Скрин 1 - при открытых тектовых файлах:
Скрин 2 - после закрытия текстовых файлов:
Листинг:
Option Explicit
Sub BatchProcess()
Dim FileSpec As String
Dim i As Integer
Dim FileName As String
Dim FileList() As String
Dim FoundFiles As Integer
' Указание пути и спецификаций файла
FileSpec = ThisWorkbook.Path & "\" & "text??.txt"
FileName = Dir(FileSpec)
' Найден ли файл?
If FileName <> "" Then
FoundFiles = 1
ReDim Preserve FileList(1 To FoundFiles)
FileList(FoundFiles) = FileName
Else
MsgBox "Не найдены файлы, которые соответствуют " & FileSpec
Exit Sub
End If
' Получение других имен файлов
Do
FileName = Dir
If FileName = "" Then Exit Do
FoundFiles = FoundFiles + 1
ReDim Preserve FileList(1 To FoundFiles)
FileList(FoundFiles) = FileName & "*"
Loop
' Циклический обход и обработка файлов
For i = 1 To FoundFiles
Call ProcessFiles(FileList(i))
Next i
End Sub
Sub ProcessFiles(FileName As String)
' Импорт файла
Workbooks.OpenText FileName:=FileName, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlFixedWidth, _
FieldInfo:= _
Array(Array(0, 1), Array(3, 1), Array(12, 1))
' Ввод суммарных формул
Range("D1").Value = "A"
Range("D2").Value = "B"
Range("D3").Value = "C"
Range("E1:E3").Formula = "=COUNTIF(B:B,D1)"
Range("F1:F3").Formula = "=SUMIF(B:B,D1,C:C)"
End Sub