Sub VBProject_References2() 'эта функция подключает к проекту библиотеку для работы с FSO
'для ее корректной работы нужно в параметрах безопасности макросов разрешить доступ к объектной модели проектов VBA!!!
iFileName$ = Environ("WinDir") & "\System32\Scrrun.dll" 

If Dir(iFileName$) <> "" Then
   Dim iReference As Object, iReferences As Object ' Variant
   'Если подключена библиотека :
     Set iReferences = ActiveDocument.VBProject.References
   For Each iReference In iReferences
       If StrComp(iReference.FullPath, iFileName$, vbTextCompare) = 0 Then
          Exit Sub
       End If
   Next
   iReferences.AddFromFile FileName:=iFileName$
Else
   MsgBox "Отсутствует нужный файл библиотеки FSO", , ""
End If
End Sub

Sub Check_Drive() 'сама функция проверки наличия в системе диска с заданной буквой
Call VBProject_References2
Dim objFSO As FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.DriveExists("F:") = True Then
MsgBox "Диск F существует!!!"
Else:
MsgBox "Диск F не существует!!!"
End If
End Sub

'1. Объявляем структуру данных
Private Type NetResource
dwScope As Long
dwType As Long	 'Тип ресурса: дисковый или принтер
dwDisplayType As Long
dwUsage As Long
lpLocalName As String	'Локальное имя ресурса, например, "x:"
lpRemoteName As String	'Сетевое имя ресурса, например, "\\server\d$"
lpComment As String
lpProvider As String	'Системный провайдер, обеспечивающий собственно подключение, например, "LDAP:"
End Type

'Примечание.
'Системный провайдер - компонент ОС Windows. Он отвечает за работу в соответствующем пространстве имен сетевых объектов.
'Если это значение не задавать, то будет выбран провайдер, действующий по умолчанию (что и рекомендую).

'2. Объявляем функции из комплекта Win32 API.

Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NetResource, ByVal strPassword As String, ByVal strUserName As String, ByVal lngFlags As Long) As Long
Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long

'3. Описываем пользовательские функции подключения и отключения ресурса.

Function AddConnection(strNetPath As String, strLocalName As String, strUserName As String, strPwd As String, Optional fPersistent As Boolean = True, Optional fDisk As Boolean = True) As Long
'Переменная fPersistent - флаг режима обновления профиля пользователя: обновлять или нет,
'по умолчанию - обновлять (значение TRUE)
'Переменная fDisk - флаг типа сетевого ресурса (диск или принтер), по умолчанию - диск (значение TRUE)

Dim usrNetResource As NetResource
Dim lngFlags As Long

With usrNetResource
.dwType = IIf(fDisk, dhcResourceTypeDisk, dhcResourceTypePrint) 'Определяем тип ресурса
'dhcResourceTypeDisk и dhcResourceTypePrint - стандартные константы функции WNetCancelConnection2
.lpLocalName = strLocalName
.lpRemoteName = strNetPath
.lpProvider = vbNullString
End With
'Задаем режим обновления профиля
lngFlags = IIf(fPersistent, dhcConnectUpdateProfile, dhcConnectDontUpdateProfile)
'Подключаемся к указанному ресурсу
AddConnection = WNetAddConnection2(usrNetResource, strPwd, strUserName, lngFlags)

End Function


Function CancelConnection(strLocalName As String, Optional forceDisconnect As Boolean = False, Optional updateUserProfile As Boolean = True) As Long
'Переменная forceDisconnect - флаг режима отключения ресурса: безусловный или нет, по умолчанию - не безусловный (FALSE)
'Безусловный режим - ресурс будет отключен, даже если есть открытые с отключаемого ресурса файлы
'Не безусловный режим - ресурс не будет отключен, если есть открытые с отключаемого ресурса файлы

Dim lngFlags As Long

'Задаем режим обновления профиля (обновлять или нет)
lngFlags = IIf(updateUserProfile, dhcConnectUpdateProfile, dhcConnectDontUpdateProfile)
'Отключаемся от ресурса
CancelConnection = WNetCancelConnection2(strLocalName, lngFlags, Abs(forceDisconnect))

End Function

'4. Проверяем работу функций подключения/отключения

Sub TestNetConnect() 'функция подключает сетевую папку \\server\c$ как диск Q из под учетной записи Администратор с паролем PASSWord
Dim cntResult As Long
cntResult = AddConnection("\\server\c$", "Q:", "Администратор", "PASSword")
End Sub


Sub TestNetDisconnect() 'функция отключает сетевой диск Q.
Dim cntResult As Long
cntResult = CancelConnection("Q:")
End Sub