Обработка сразу нескольких внешних файлов

Листинг 3.105. Обработка текстовых файлов

Sub ImportTextFiles()

Dim fsSearch As FileSearch

Dim strFileName As String

Dim strPath As String

Dim i As Integer

' Задание пути и возможного имени файла

strFileName = ThisWorkbook.path & "\"

strPath = "text??.txt"

' Создание объекта FileSearch

Set fsSearch = Application.FileSearch

' Настройка объекта для поиска

With fsSearch

' Маска для поиска

.LookIn = strFileName

' Путь для поиска

.FileName = strPath

' Поиск всех файлов, удовлетворяющих маске

.Execute

' Выход, если файлы не существуют

If.FoundFiles.Count = 0 Then

MsgBox "Файлы не обнаружены"

Exit Sub

End If

End With

' Обработка найденных файлов

For i = 1 To fsSearch.FoundFiles.Count

Call ImportTextFile(fsSearch.FoundFiles(i))

Next i

End Sub

Sub ImportTextFile(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

Запуск таблицы символов из Excel

Листинг 3.106. Вызов таблицы символов

Sub ShowSymbolTable()

On Error Resume Next

' Запуск Charmap.exe - таблицы символов

Shell "Charmap.exe", vbNormalFocus

If Err <> 0 Then

MsgBox "Невозможно запустить таблицу символов.", vbCritical

End If

End Sub

Листинг 3.107. Таблица символов

' Декларация API-функций:

' для открытия процесса

Declare Function OpenProcess Lib "kernel32" _

(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _

ByVal dwProcessId As Long) As Long

' для получения кода завершения процесса

Declare Function GetExitCodeProcess Lib "kernel32" _

(ByVal hProcess As Long, lpExitCode As Long) As Long

' для закрытия процесса

Declare Function CloseHandle Lib "kernel32" _

(hProcess) As Long

Sub ShowSymbolTable1()

Dim lProcessID As Long

Dim hProcess As Long

Dim lExitCode As Long

On Error Resume Next

' Запуск таблицы символов (Charman.exe). Функция возвращает _

идентификатор созданного процесса

lProcessID = Shell("Charmap.exe", 1)

If Err <> 0 Then

MsgBox "Нельзя запустить Charman.exe", vbCritical, "Ошибка"

Exit Sub

End If

' Открытие процесса по идентификатору (lProcessID). Функция _

возвращает дескриптор процесса (handle)

hProcess = OpenProcess(&H400, False, lProcessID)

' Ждем, пока процесс завершится, для этого периодически _

получаем код завершения процесса (пока Charman.exe исполняется, _

функция GetExitCodeProcess возвращает &H103)

Do

GetExitCodeProcess hProcess, lExitCode

DoEvents

Loop While lExitCode = &H103

' Закрытие процесса

CloseHandle (hProcess)

' Вывод на экран информационного сообщения

MsgBox "Charmap.exe завершает свою работу"

End Sub

Дата добавления: 2015-06-25