Глава 2. Работа с файлами (т.Е.Обмен данными с тхт, rtf, xls и т.Д.) Проверка наличия файла по указанному пути_1

Sub VerifyFileLocation()

Dim strFileName As String

Dim strFileTitle As String

' Имя и путь искомого файла

strFileTitle = "primer.xls"

strFileName = "C:\Документы\primer.xls"

' Проверка наличия файла (функция Dir возвращает пустую _

строку, если по указанному пути файл обнаружить не удалось)

If Dir(strFileName) <> "" Then

MsgBox "Файл " & strFileTitle & " найден"

Else

MsgBox "Файл " & strFileTitle & " не найден"

End If

End Sub

Проверка наличия файла по указанному пути_2

Sub VerifyFileLocation1()

Dim strFileName As String

' Имя искомого файла

strFileName = "C:\Документы\primer.xls"

' Проверка наличия файла (функция Dir возвращает пустую _

строку, если по указанному пути файл обнаружить не удалось)

If Dir(strFileName) <> "" Then

MsgBox "Файл " & strFileName & " найден"

Else

MsgBox "Файл " & strFileName & " не найден"

End If

End Sub

Проверка наличия файла по указанному пути_3

Sub Check_Disk()

On Error Resume Next

If Dir("\\192.168.1.200\c\", vbSystem) <> "" Then

If Err = 52 Then

Err.Clear

MsgBox "Диска нет!", 48, "Ошибка"

Exit Sub

End If

If Err <> 0 Then

MsgBox "Произошло ошибка!", 48, "Ошибка"

Exit Sub

Else

On Error GoTo 0

MsgBox "Диск есть!", 64, ""

End If

End If

End Sub

Поиск нужного файла_1

Sub FileSearch()

Dim strFileName As String

Dim strFolder As String

Dim strFullPath As String

' Задание имени папки для поиска

strFolder = InputBox("Определите папку:")

If strFolder = "" Then Exit Sub

' Задание имени файла для поиска

strFileName = Application.InputBox("Введите имя файла:")

If strFileName = "" Then Exit Sub

' При необходимости дополняем имя папки "\"

If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"

' Полный путь файла

strFullPath = strFolder & strFileName

' Вывод окна с отчетом о поиске средствами VBA

MsgBox "Использование команды VBA..." & vbCrLf & vbCrLf & _

dhSearchVBA(strFullPath), vbInformation, strFullPath

' Вывод окна с отчетом о поиске средствами объекта FileSearch

MsgBox "Использование объекта FileSearch..." & vbCrLf & _

vbCrLf & dhSearchFileSearch(strFolder, strFileName), vbInformation, _

strFullPath

' Вывод окна с отчетом о поиске средствами объекта _

FileSystemObject

MsgBox "Использование объекта FileSystemObject..." & vbCrLf & _

vbCrLf & dhSearchFileSystemObject(strFullPath), vbInformation, _

strFullPath

End Sub

Поиск нужного файла_2

Function dhSearchVBA(varFullPath As Variant) As Boolean

' Использование команды VBA

dhSearchVBA = Dir(varFullPath) <> ""

End Function

Поиск нужного файла_3

Function dhSearchFileSearch(varFolder As Variant, varFileName _

As Variant) As Boolean

' Использование объекта FileSearch

With Application.FileSearch

' Создание нового поиска

.NewSearch

' Имя для поиска

.FileName = varFileName

' Папка поиска

.LookIn = varFolder

' Собственно поиск

.Execute

dhSearchFileSearch = .FoundFiles.Count <> 0

End With

End Function

Поиск нужного файла_4

Function dhSearchFileSystemObject(varFullPath As Variant) As Boolean

Dim objFSObject As Object

' Использование объекта FileSystemObject

Set objFSObject = CreateObject("Scripting.FileSystemObject")

dhSearchFileSystemObject = objFSObject.FileExists(varFullPath)

End Function

Автоматизация удаления файлов

Листинг 3.51. Удаление файла

Sub DeleteFile()

Kill "C:\Документы\primer.xls"

End Sub

Листинг 3.52. Удаление группы файлов

Sub DeleteFiles()

' Удаление всех файлов с расширением XLS из заданной папки

Kill "C:\Документы" & "*.xls"

End Sub

Произвольный текст в строке состояния

Sub ChangeStatusBarText()

Application.StatusBar = "Как надоело работать!!!"

End Sub

Восстановление строки состояния

Sub ReturnStatusBarText()

Application.StatusBar = False

End Sub

Бегущая строка в строке состояния

Sub MovingTextInStatusBar()

Dim intSpaces As Integer

' Изменение количества пробелов в начале строки (от 20 до 0) - _

строка бежит (скорее, ползет) влево

For intSpaces = 20 To 0 Step -1

' Запись текста в строку состояния

Application.StatusBar = Space(intSpaces) & "Как надоело работать!!!"

' Выдерживаем паузу

Application.Wait Now + TimeValue("00:00:01")

' Дадим Excel обработать пользовательский ввод

DoEvents

Next

Application.StatusBar = False

End Sub

Быстрое изменение заголовка окна

Sub NewTitle()

Application.Caption = "Какая хорошая погода"

End Sub

Быстрое изменение заголовка окна_2

Sub NewTitle()

Application.Caption = "Какая хорошая погода"

ActiveWindow.Caption = "А завтра будет дождь"

End Sub

Изменение заголовка окна (со скрытием названия файла)

Sub NewTitle()

Application.Caption = "Какая хорошая погода"

ActiveWindow.Caption = ""

End Sub

Возврат к первоначальному заголовку

Sub ReturnTitle()

' Возвращение заголовка приложения (то есть Excel)

Application.Caption = Empty

' Указание правильного названия открытого файла (книги)

ActiveWindow.Caption = ThisWorkbook.Name

End Sub

Что открыто в данный момент

Sub WorkBooksList()

Dim book As Object

' Вывод имени каждой рабочей книги

For Each book In Workbooks

MsgBox (book.Name)

Next

End Sub

Работа с текстовыми файлами

Открываются файлы командой Open, а закрываются - командой Close.

Sub Test()

Open "file.txt" For Input As #1

Close #1

End Sub

Запись и чтение текстового файла

Sub Test()

Open "file.txt" For Output As #1

Print #1, "Этот текст будет записан в файл"

Close #1

Open "file.txt" For Input As #1

Dim s As String

Input #1, s

MsgBox s

Close #1

End Sub

Для записи используется оператор Print, а для чтения - Input. У этих операторов есть свои особенности.

Print #1, "Hello , File"

Оператор Input #1 прочитает только Hello и все. Запятая воспринимается как разделитеть. Чтобы прочитать строку целиком, используется оператор Line Input.

Sub Test()

Open "file.txt" For Output As #1

Print #1, "Hello , File"

Close #1

Open "file.txt" For Input As #1

Dim s As String

Line Input #1, s

MsgBox s

Close #1

End Sub