Как узнать имя создателя сетевой папки в VBA?

Пользователь

Сообщений: 309 Регистрация: 24.12.2012

01.08.2019 14:37:36

Коллеги, подскажите, пожалуйста, есть ли способ макросом узнать какой пользователь является создателем сетевой папки?
Ну или хотя бы как-то программно можно узнать разрешения сетевой папки? (кнопка "Дополнительно" на вкладке "Безопасность" в свойствах папки).

Спасибо.

БМВ

Модератор

Сообщений: 23291 Регистрация: 28.12.2016

Excel 2013, 2016

01.08.2019 15:27:54

В закромах такое было

Скрытый текст

Код

Sub AccessRights()
strComputer = "."

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objFile = objWMIService.Get("Win32_LogicalFileSecuritySetting='Z:\Folder'")

If objFile.GetSecurityDescriptor(objSD) = 0 Then

Debug.Print "Owner: " & objSD.Owner.Name
Debug.Print

For Each objAce In objSD.DACL
    Debug.Print "Trustee: " & objAce.Trustee.Domain & "\" & objAce.Trustee.Name

    If objAce.AceType = 0 Then
        strAceType = "Allowed"
    Else
        strAceType = "Denied"
    End If
    Debug.Print "Ace Type: " & strAceType

    Debug.Print "Ace Flags:"

    If objAce.AceFlags And 1 Then
        Debug.Print vbTab & "Child objects that are not containers inherit permissions."
    End If

    If objAce.AceFlags And 2 Then
        Debug.Print vbTab & "Child objects inherit and pass on permissions."
    End If

    If objAce.AceFlags And 4 Then
        Debug.Print vbTab & "Child objects inherit but do not pass on permissions."
    End If

    If objAce.AceFlags And 8 Then
        Debug.Print vbTab & "Object is not affected by but passes on permissions."
    End If

    If objAce.AceFlags And 16 Then
        Debug.Print vbTab & "Permissions have been inherited."
    End If

    Debug.Print "Access Masks:"
    If objAce.AccessMask And 1048576 Then
        Debug.Print vbTab & "Synchronize"
    End If

    If objAce.AccessMask And 524288 Then
        Debug.Print vbTab & "Write owner"
    End If
    If objAce.AccessMask And 262144 Then
        Debug.Print vbTab & "Write ACL"
    End If
    If objAce.AccessMask And 131072 Then
        Debug.Print vbTab & "Read security"
    End If
    If objAce.AccessMask And 65536 Then
        Debug.Print vbTab & "Delete"
    End If
    If objAce.AccessMask And 256 Then
        Debug.Print vbTab & "Write attributes"
    End If
    If objAce.AccessMask And 128 Then
        Debug.Print vbTab & "Read attributes"
    End If
    If objAce.AccessMask And 64 Then
        Debug.Print vbTab & "Delete dir"
    End If
    If objAce.AccessMask And 32 Then
        Debug.Print vbTab & "Execute"
    End If
    If objAce.AccessMask And 16 Then
        Debug.Print vbTab & "Write extended attributes"
    End If
    If objAce.AccessMask And 8 Then
        Debug.Print vbTab & "Read extended attributes"
    End If
    If objAce.AccessMask And 4 Then
        Debug.Print vbTab & "Append"
    End If

    If objAce.AccessMask And 2 Then
        Debug.Print vbTab & "Write"
    End If

    If objAce.AccessMask And 1 Then
        Debug.Print vbTab & "Read"
    End If

    Debug.Print
    Debug.Print
Next

End If


End Sub

Изменено: БМВ - 01.08.2019 16:05:47

По вопросам из тем форума, личку не читаю.

Ігор Гончаренко Пользователь Сообщений: 14576 Регистрация: 01.01.1970	#3 01.08.2019 15:39:15 ну, прямо уже в закромах похоже где-то по сусекам валялось Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

БМВ

Модератор

Сообщений: 23291 Регистрация: 28.12.2016

Excel 2013, 2016

01.08.2019 16:08:12

Перезалил код выше, переводы строки порой шутят :-)

Цитата
Ігор Гончаренко написал: прямо уже в закромах

ну может и в сусеках, это раньше диск HDD был круглый, а теперь SSD с углами :-)

По вопросам из тем форума, личку не читаю.

Wild.Godlike Пользователь Сообщений: 648 Регистрация: 23.05.2018	#5 01.08.2019 16:10:21 БМВ, Я же правильно понимаю данный код выводит информацию в Immediate?

БМВ Модератор Сообщений: 23291 Регистрация: 28.12.2016 Excel 2013, 2016	#6 01.08.2019 16:15:26 Wild.Godlike, Должен туда выводить. Это ж пример. Я правда сейчас засомневался. Это было для папки, а работает ли для файла - не проверял. По вопросам из тем форума, личку не читаю.

Wild.Godlike Пользователь Сообщений: 648 Регистрация: 23.05.2018	#7 01.08.2019 16:20:05 БМВ, а вопросов про файл и не было) UPD. затестил на файле. работает Прикрепленные файлы Снимок.PNG (35.58 КБ) Изменено: Wild.Godlike - 01.08.2019 16:26:01

Ezoptron

Пользователь

Сообщений: 309 Регистрация: 24.12.2012

01.08.2019 16:48:58

Всем спасибо за помощь. Нашёл-таки ещё на одном форуме решение, переделал его слегка, и вот что у меня получилось:

Код

sub vlad ()
a = "C:\Папка"
objpapka = "winmgmts:Win32_LogicalFileSecuritySetting.path=" & "'" & a & "'"
Set wmiFileSecSetting = GetObject(objpapka)
Dim wmiSecurityDescriptor
RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
Set wmiAce = wmiSecurityDescriptor.DACL(0)
Set Trustee = wmiAce.Trustee
s = Trustee.Name
end sub

Изменено: Ezoptron - 01.08.2019 16:50:19