Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
VBA в примерах .doc
Скачиваний:
113
Добавлен:
03.05.2015
Размер:
1.33 Mб
Скачать

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

Листинг 3.48.Проверка наличия файла (вариант 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

Листинг 3.49. Проверка наличия файла (вариант 2)

SubVerifyFileLocation1()

Dim strFileName As String

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

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

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

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

If Dir(strFileName) <> "" Then

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

Else

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

End If

End Sub

Листинг 3.50. Поиск нужного файла

SubFileSearch()

Dim strFileName As String

Dim strFolder As String

DimstrFullPathAsString

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

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

If strFolder = "" Then Exit Sub

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

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

IfstrFileName= ""ThenExitSub

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

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

Function dhSearchVBA(varFullPath As Variant) As Boolean

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

dhSearchVBA = Dir(varFullPath) <> ""

End Function

Function dhSearchFileSearch(varFolder As Variant, varFileName _

As Variant) As Boolean

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

WithApplication.FileSearch

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

.NewSearch

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

.FileName = varFileName

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

.LookIn=varFolder

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

.Execute

dhSearchFileSearch = .FoundFiles.Count <> 0

End With

End Function

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

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]