VBA. Задумчивость функции DIR

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Ответить
Avsha
Сообщения: 665
Зарегистрирован: 08 сен 2005, 13:47
Откуда: KZ

Приветствую!

При обращении к файлу на недоступном сетевом ресурсе ([url=file://\\netpc\temp\myfile.txt]\\netpc\temp\myfile.txt[/url]) с помощью функции DIR происходит ошибка, а что самое плохое, задержка при выполнении.

Код: Выделить всё

 
On Error GoTo ErrorHandle
' определение пути поиска

MyPath = "[url=file://netpc/temp/]\\netpc\temp\[/URL]"

' поиск первого элемента
myfile = Dir(MyPath + "myfile.txt")
If myfile = "" Then MsgBox "В указанном пути нет файла !": Exit Sub
Do While myfile <> ""
        ' операции с очередным MyFile
        If InStr(1, myfile, "myfile.txt", vbTextCompare) <> 0 Then GoTo 1
        ' поиск нового MyFile
    myfile = Dir
Loop
1:
 
MsgBox "есть доступ :) "
 
Exit Sub
ErrorHandle:

MsgBox "нет доступа :( "

Есть ли способ обойти эту задержку в выполнении программы?
Аватара пользователя
Aent
Сообщения: 1129
Зарегистрирован: 01 окт 2006, 14:52
Откуда: Saratov,Russia
Контактная информация:

Две идеи:
1) До Dir опредлять доступен ли рессурс
Я года полтора назад отвечал как из программы на VBA отпинговать адрес
Поищите на этом форуме.
2) Создать таймер и ассинхронно прерывать программу (не уверен что получится)
Avsha
Сообщения: 665
Зарегистрирован: 08 сен 2005, 13:47
Откуда: KZ

Aent, спасибо за отклик,
1 вариант тоже держал в уме, вашим форумным предложением про Ping давно и успешно пользуюсь :)

повторю для порядка...

Код: Выделить всё

Function PingTest(strHostOrIP)
     Dim objSh, strCommand, intWindowStyle, blnWaitOnReturn
     blnWaitOnReturn = True
     intWindowStyle = 0
     strCommand = "%ComSpec% /C %SystemRoot%\system32\ping.exe -n [B]1[/B] -w [B]100[/B] " _
                   & strHostOrIP & " | " & "%SystemRoot%\system32\find.exe /i " _
                   & Chr(34) & "TTL=" & Chr(34)
     Set objSh = CreateObject("WScript.Shell")
     PingTest = Not CBool(objSh.Run(strCommand, intWindowStyle, blnWaitOnReturn))
     Set objSh = Nothing
End Function

If PingTest(Target) Then ...
Ответить