VBS: Проверка доступности сетевого ресурса в домене

dim UserSettingsPut
' Путь размещения файла конфигурации 
UserSettingsPut = "D:\OSR\MyHTA_files\UserSettings.txt"
dim UserActiv
dim UserSettingsLine
dim i,j
Dim objFSO, oFso

'Количество адресов у пользователя с одним логином записанном в конфиге
dim UserHowMuchAdres

Dim FilesSelectElementHave
FilesSelectElementHave = 0


'Переменные созданные для работы с данными пользователя
dim UserSettingsLogin()
dim UserSettingsAdres()
dim UserSettingsAdresName()
dim UserSettingsLastName()
dim UserSettingsName()
dim UserSettingsMiddleName()
dim UserSettingsEmail()
dim UserSettingsPhone()
dim UserSettingsTabel()
dim UserSettingsOtdel()

'Массив определяющий доступ к сетевому ресурсу
dim UserSettingsDostup()

reDim UserSettingsLogin(1)
reDim UserSettingsAdres(1)
reDim UserSettingsAdresName(1)
reDim UserSettingsLastName(1)
reDim UserSettingsName(1)
reDim UserSettingsMiddleName(1)
reDim UserSettingsEmail(1)
reDim UserSettingsPhone(1)
reDim UserSettingsTabel(1)
reDim UserSettingsOtdel(1)
reDim UserSettingsDostup(1)




Dim UserSettingsLine1(1)

i=0
For i=0 To j Step 1
if  UserSettingsLine1(0) = "" Then
MsgBox "Сработало условие"
End If 

Next














i=0
UserHowMuchAdres = "Нет заявки на подключение"
Set objFso = CreateObject("Scripting.FileSystemObject")
if  objFso.FileExists(UserSettingsPut)  Then
    'MsgBox "Файл найден"
    Set objNetwork = CreateObject("Wscript.Network")
    UserActiv = objNetwork.UserName                        
    'MsgBox "Логин пользователя считан " &UserActiv
    Set vStream = objFso.OpenTextFile(UserSettingsPut, 1, True) 
        Do Until vStream.AtEndOfStream 'цикл по строкам файла
            sLine = vStream.ReadLine 
            'MsgBox "Прочитана строка: " & sLine 
            UserSettingsLine = Split(sLine,";")
            'Проверка на окончание файла конфигурации
            if  UserSettingsLine(0) <> "---" Then 
                if  UserSettingsLine(0) = UserActiv Then
                    UserHowMuchAdres=i
                    MsgBox UserSettingsLine(1) &UserSettingsLine(9) &"  " &i
                    UserSettingsLogin(i) = UserSettingsLine(0)
                    UserSettingsAdres(i) = UserSettingsLine(1)
                    UserSettingsAdresName(i) = UserSettingsLine(2)
                    UserSettingsLastName(i) = UserSettingsLine(3)
                    UserSettingsName(i) = UserSettingsLine(4)
                    UserSettingsMiddleName(i) = UserSettingsLine(5)
                    UserSettingsEmail(i) = UserSettingsLine(6)
                    UserSettingsPhone(i) = UserSettingsLine(7)
                    UserSettingsTabel(i) = UserSettingsLine(8)
                    UserSettingsOtdel(i) = UserSettingsLine(9)
                    UserSettingsDostup(i) = "Доступ не определен"
                    i=i+1
                    reDim preserve UserSettingsLogin(i)
                    reDim preserve UserSettingsAdres(i)
                    reDim preserve UserSettingsAdresName(i)
                    reDim preserve UserSettingsLastName(i)
                    reDim preserve UserSettingsName(i)
                    reDim preserve UserSettingsMiddleName(i)
                    reDim preserve UserSettingsEmail(i)
                    reDim preserve UserSettingsPhone(i)
                    reDim preserve UserSettingsTabel(i)
                    reDim preserve UserSettingsOtdel(i)
                    reDim preserve UserSettingsDostup(i)
                End If
            Else
                Exit Do                    
            End If
        Loop
    vStream.Close 'закрываем файл
    Else
        MsgBox "Файл конфигурации пользователя UserSettings.txt не найден обратитесь к администратору!"
End If    
Set objFso = Nothing

'Проверка доступности ресурса при помощи создания и удаления папки
'Так же осуществляется проверка на учетки которым недоступен сетевой ресурс
'MsgBox "Сейчас учеток" &UserHowMuchAdres


if  UserHowMuchAdres = "Нет заявки на подключение" Then
    UserHowMuchAdres = "Нет заявки на подключение"
Else
    if  UserHowMuchAdres > 0 Then
        i=0
        j=UserHowMuchAdres
        'MsgBox UserSettingsAdres(i) &UserSettingsLogin(i)
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        For i=0 To j Step 1
            objFSO.CreateFolder (UserSettingsAdres(i) &UserSettingsLogin(i))
            'objFSO.DeleteFolder (UserSettingsAdres(i) &UserSettingsLogin(i))
            'MsgBox "Удали папку" &UserSettingsLogin(i)
            If objFSO.FolderExists(UserSettingsAdres(i) &UserSettingsLogin(i)) Then
                'MsgBox "Folder found"
                objFSO.DeleteFolder (UserSettingsAdres(i) &UserSettingsLogin(i))
                UserSettingsDostup(i) = "Есть доступ к сетевому ресурсу"
            Else
                'MsgBox "Folder  not found" &UserSettingsLogin(i)
                UserSettingsDostup(i) = "Нет доступа к сетевому ресурсу"
            End If
    
        Next
        Set objFSO = Nothing
    Else
        if  UserHowMuchAdres = 0 Then
            i=0
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            objFSO.CreateFolder (UserSettingsAdres(i) &UserSettingsLogin(i))
            'MsgBox "Удали папку" &UserSettingsLogin(i)
            If objFSO.FolderExists(UserSettingsAdres(i) &UserSettingsLogin(i)) Then
                objFSO.DeleteFolder (UserSettingsAdres(i) &UserSettingsLogin(i))
                UserSettingsDostup(i) = "Есть доступ к сетевому ресурсу"
            Else
                UserSettingsDostup(i) = "Нет доступа к сетевому ресурсу"
            End If
            Set objFSO = Nothing
        End if
    End If
End if

' Обработчики кнопки Принять *******************************
Sub MenuInButtonId_OnClick()
        


            Dim UserChooseFolder
            UserChooseFolder = UserSettingsAdres(0)
            Set FSO = CreateObject("Scripting.FileSystemObject")
            Set Folder = FSO.GetFolder(UserChooseFolder)
        
            Show MenuOutChooseTable
            Show MenuInChooseTableNext 

            Dim objHTMLOptionElement
            
            ' Цикл обнуления записей введенных ранее
            if FilesSelectElementHave = "1" Then 
            'MsgBox "В массиве есть данные" &FilesSelectElementHave
            Dim objChildNode
            If MenuOutChooseTableoHTMLSelectElement.hasChildNodes() Then
                For Each objChildNode In MenuOutChooseTableoHTMLSelectElement.ChildNodes
                    MenuOutChooseTableoHTMLSelectElement.removeChild objChildNode
                Next
            End If
            
            End If
            
            
            


            Set folderCollection = Folder.subFolders
            
            For Each subFolder In folderCollection

                MsgBox 111
                Set fileCollection = subFolder.Files   
                For Each file In fileCollection
                    MsgBox file.Path
                        Set objHTMLOptionElement = window.document.createElement("OPTION")
                        objHTMLOptionElement.Text  = File.Name & VBCRLF &"111"
                        objHTMLOptionElement.Value = File.Path & VBCRLF 
                        MenuOutChooseTableoHTMLSelectElement.Add objHTMLOptionElement        
                    MsgBox File.Name
                    MsgBox File.Path
                Next 
            Next
            
            
            
            For Each File In Folder.Files
                Set objHTMLOptionElement = window.document.createElement("OPTION")
                'MsgBox MenuOutChooseTableoHTMLSelectElement
                objHTMLOptionElement.Text  = File.Name & VBCRLF
                objHTMLOptionElement.Value = File.Path & VBCRLF 
                MenuOutChooseTableoHTMLSelectElement.Add objHTMLOptionElement
            Next
            
            
            

            
            
            FilesSelectElementHave = 1
    
    Set FSO = Nothing    
    Set objFolder = Nothing        

End Sub