getting a list of users with permissions to a workbook

  • Thread starter Thread starter Eric
  • Start date Start date
E

Eric

I have a workbook on a shared exchange folder, and I want to create a list
of all of those users in a new sheet.

Can I do this?

TIA
 
I got this to work, but it took some tweaking. First make sure to
download the ADSI resource kit from the link I posted. Copy the script
and paste it into a file, save the file with a .vbs extension. I name
my file Check_Perms.vbs.

Paste the following at the bottom of the .vbs file, and make sure to
correct lines that have been cut off.

Sub WriteToLog(Message, sTarget) ' Creating and writing to a text file
Dim fLog, Fso
Set Fso = CreateObject("Scripting.FileSystemObject")
' Create the log file if it does not exist
If not Fso.FileExists(sTarget & ".txt") Then
Set fLog = Fso.CreateTextFile(sTarget & ".txt", True)
fLog.Close
End If
' Append to the log file
Set fLog = Fso.OpenTextFile(sTarget & ".txt", 8)
fLog.WriteLine(Message)
fLog.Close
End Sub

Then replace the wscript.echo commands with a command calling the sub I
just gave you. Example:
WriteToLog sMsg & "ADS_ACEFLAG_UNKNOWN", sTarget

Now in your Excel sheet use:
Private Sub Workbook_Open()
Dim strTextFilePath As String
strTextFilePath = ActiveWorkbook.FullName & ".txt"
'Creates temporary permissions text file
'Correct the .vbs path name in the shell command
Shell ("cscript //nologo H:\Excel\WritePerms.vbs ACTION=SHOW
TARGET=" & ActiveWorkbook.FullName)

While Dir(strTextFilePath) = ""
'Waits for file to be created
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Wend

'Imports permissions text file
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & strTextFilePath, Destination:=Range("A1"))
.SaveData = True
.AdjustColumnWidth = True
.TextFilePlatform = xlWindows
.TextFileStartRow = 2
.TextFileParseType = xlFixedWidth
.TextFileColumnDataTypes = Array(1, 1)
.TextFileFixedColumnWidths = Array(20)
.Refresh BackgroundQuery:=False
End With

'Deletes temporary file
Kill strTextFilePath
End Sub

Let me know if it works for you.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top