Автокопирование на сетевой диск

[EducatedFool]

нельзя ли, как нибудь придумать проверку, типа: если сетевой ресурс активен х = 1, а не активен, х = 0

Придумать-то можно.
Но эта проверка будет занимать ровно столько же времени, как и обращение к сетевому файлу...

Ведь невозможно проверить активность ресурса, не обратившись к нему.
А ответ OC получает лишь спустя некоторое время...

Но всё это верно лишь в случае, если мы обращаемся к удалённому компу по NetBIOS-имени. (или проверяем наличие файла\папки на сетевом ресурсе)
В случае с IP-адресами можно попробовать пропинговать нужный комп - ответ на пинг обычно приходит значительно быстрее.

Если очень надо - могу внедрить в твой файл функцию, которая возвращает 0 или 1 в зависимости от доступности компа с адресом 192.168.2.50
Но не факт, что это ускорит процесс...

[EducatedFool]

Sub test()
    If PingB("192.168.2.50") Then
        MsgBox "Комп с адресом 192.168.2.50 доступен", vbInformation
    Else
        MsgBox "Комп с адресом 192.168.2.50 недоступен", vbExclamation
    End If
End Sub

Sub test2()
    ' проверяем пинг:
    If Not PingB("192.168.2.50") Then Exit Sub

    ' пинг прошел - работаем с сетевым ресурсом
End Sub

Чтобы у тебя эта функция работала, перетащи мышкой модуль Ping_Module из моего файла в свой файл:



PS: Эту функцию можно использовать и в ячейках:

  Ячейка: B1      Формула  (стиль A1):   =PingB(A1)
                  Формула  (стиль R1C1): =PingB(RC[-1])

[valerij]

Сообщение от EducatedFool

перетащи мышкой модуль Ping_Module из моего файла в свой файл

Перетащил, а как или что, запустит модуль test()
Его надо связывать с http://www.programmersforum.ru/showp...13&postcount=9 ???

Ни фига себе модуль, Игорь когда ты успел его написать, ну даешь!!!
Профи, ну что скажешь!!

[EducatedFool]

Его надо связывать с http://www.programmersforum.ru/showp...13&postcount=9 ???

Да, конечно.
Как-то так:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Const s0 = "\\192.168.2.50\public\Ноябрь\", s1 = "F:\Home\public\Ноябрь\", s2 = "Ноябрь.xls"
    Const sM = "Сохранить резервную копию ?"
    Dim s$
    On Error Resume Next
    ThisWorkbook.Save

    If PingB("192.168.2.50") Then
        s = s0 + s2
    Else
        s = (Dir(s1, vbDirectory))
        If Not Len(s) = 0 Then s = s1 + s2
        Err.Clear
    End If
    If Len(s) = 0 Then
        'выход без запроса
    ElseIf MsgBox(sM, vbQuestion + vbYesNo, Empty) = vbYes Then
        If Len(Dir(s)) > 0 Then Kill s
        If Err.Number = 0 Then ThisWorkbook.SaveAs s, xlNormal
    End If
End Sub

[valerij]

Сообщение от EducatedFool

Да, конечно.

Щас попробую, тут еще ср-ная семерка(чистая), вытворяет, если при выключенном сетевом, запускаю твой пример, все виснет, заливается молоком..... в ХР, все четко.
Все же, точно, что самая удачная Ось у Microsoft - это ХР

Игорь, вставил код, теперь закрыть книгу не могу, не реагирут....

[valerij]

Игорь, скрин, это при выключенном сетевом, при включенном, все ОК,
работает быстро

Все проверил в ХР и все работает, а в W7-64, нет!!!
Вобщем все проверил, разрядность 7 не имеет значения, та же фигня, вот че пишет:
Имя приложения: EXCEL.EXE
Версия приложения: 11.0.8169.0
Отметка времени приложения: 465f27bd
Имя модуля с ошибкой: ntdll.dll
Версия модуля с ошибкой: 6.1.7600.16385
Отметка времени модуля с ошибкой: 4a5bdadb
Код исключения: c0000005
Смещение исключения: 0002fc47
Версия ОС: 6.1.7600.2.0.0.256.1
Код языка: 1049

[valerij]

Игорь, поставил для пробы, MICROSOFT.OFFICE.2010 и запустил твой пример, вот результат, че он хочет ???

[EducatedFool]

вот результат, че он хочет ???

Ну так переведи текст сообщения об ошибке на русский, и поймёшь...

[valerij]

Сообщение от EducatedFool

Ну так переведи текст сообщения об ошибке на русский, и поймёшь...

Я думал тебе, интересно будет....
Ну да бог сним, обойдусь, спасибо!!!

[EducatedFool]

Я думал тебе, интересно будет....

Мне, конечно, интересно.
Но я-то знаю английский, и сразу понял смысл сообщения.

Но, для того, чтобы предложить тебе готовое универсальное решение (под Excel 2003, 2007, 2010), мне как минимум надо установить на комп 64-разрядную систему, и Office 2010.
А исключительно для отладки этого кода мне не хочется этим заниматься.

Мне сейчас важнее круглосуточная стабильная работа компа и Excel, нежели тестирование OC и офисных пакетов.