|
А вот как  Sub Main()
On Error Resume Next
'Начало работы и запрос разрешения пользователя на проверку и подключение
If MsgBox("Сейчас будет произведена проверка" & vbCrLf & "и подключение сетевого диска." & vbCrLf & "Желаете продолжить?", vbYesNo + vbQuestion) <> vbNo Then
'Объявление переменных
 im net, i, oDrives, strPath
'Присваивание значений
Set net = CreateObject("WScript.Network")
Set oDrives = net.EnumNetworkDrives
'Перебор всех дисков на машине
For i = 0 to oDrives.Count - 1 Step 2
'Поиск сетевого диска. Иногда может быть "D:"
if oDrives.Item(i) = "J:" Then
'Вывод сообщения о том, что сетевой диск имеется в наличии на машине.
MsgBox "Диск подключен." & vbCrLf & "Проблема в другом!"
'Вываливаемся из функции
Exit Sub
End If
'Цикл
Next
'Запрос пользователя на режим работы.
If MsgBox("Желаете подключить диск в автоматическом режиме?" & vbCrLf & "Нажатием на `нет` вы можете ввести полный путь для подключения", VbYesNo + vbQuestion, "Режим подключения") <> vbNo Then
'Установка диска
net.MapNetworkDrive "J:", "\\Пк2\C","True","",""
Else
'Запрос полного пути для подключения, по умолчанию равен "\\Пк2\C"
strPath = InputBox ("Введите путь для подключения диска", "Ручное подключение", "\\Пк2\C")
'Если пользователь нажал на отмену
If Len(strPath)=0 Then
'Выводим сообщение, что ничего не было cделано и вываливаемся из функции
MsgBox "Диск не был подключен"
Exit Sub
Else
'Пользователь задал путь и нажал на Ок
'Установка диска по заданному пути
net.MapNetworkDrive "J:", strPath,"True","",""
End If
End If 'Проверка наличия ошибки после предыдущей процедуры.
If (Err.Number <> 0) Then
'Если имела место быть некая ошибка, то выводим сообщение
MsgBox "Компьютер, к которому производится подключение, выключен, либо недоступен!" & vbCrLf & "Попробуйте повторить попытку после того, как убедитесь, что второй компьютер включен.", vbCritical
'вываливаемся из функции, для того, чтобы не появилось сообщение о том, что все хорошо
Exit sub
End if
'выводим сообщение о том, что диска не было и мы его удачно подключили.
MsgBox "Готово!" & vbCrLf & "Пробуйте!", vbInformation
Else
'Вываливаемся из функции - пользователь ответил, что ничего он не хочет
Exit Sub
End If
End Sub
'вызов нашей функции
Call main 
Ответить
|
User Unknown | ICQ: uu@jabber.cz 
Grayich