Setting Folder Security in VBA for Excel

Question

Hi, following on from the success of my previous post which was answered extremely quickly so thank you for that.

I have a slightly more indepth problem to solve.

I need to set security on a folder to read only.  This will allow me to put files into the folder and then lock them down, which will in turn prevent them from being altered or removed but still allow them to be read.

The obvious tool within the VBA box is the FileSystemObject.  I can set the attribute of the folder object to 1 (Read-Only) but there is no security behind this and so in theory anyone could just untick the read-only box in the properties section.  Plus it wouldn't offer security to prevent anyone deleting the files....so it doesn't really tick the box.

I have tried using ADsSecurity.  I found an online document which goes to show how to use it, but the examples are for VBS and VB6.  Normally this wouldn't be a problem, however my windows 10 machine didn't have the ADsSecurity.dll.  I have now downloaded this, and successfully registered using RegSvr32.  I have tried both early and late binding, but I am still receiving an error message stating ActiveX can't create object.

Sub TestApprovalEB ()

  Dim oSec as ADsSecurity 

  Set oSec=New ADsSecurity

End Sub

Sub TestApprovalLB ()

  Dim oSec as Object

  Set oSec=CreateObject("ADsSecurity")

End Sub

I have both Active DS Type Library and ADsSecurity 2.5 Type Library ticked in the references

The next option I tried was using a series of API calls

lResult = LookupAccountName(vbNullString, sUserName, bUserSid(0), 255, sDomainName, lDomainNameLength, lSIDType)

sDomainName = Space(lDomainNameLength)

lResult = LookupAccountName(vbNullString, sUserName, bUserSid(0), 255, sDomainName, lDomainNameLength, lSIDType)

If (lResult = 0) Then

    MsgBox "Error: Unable to Lookup the Current User Account: " & sUserName

    Exit Sub

  End If

lResult = GetFileSecurityN(sFileName, DACL_SECURITY_INFORMATION, 0, 0, lSizeNeeded)

  ReDim bSDBuf(lSizeNeeded)

  lResult = GetFileSecurity(sFileName, DACL_SECURITY_INFORMATION, bSDBuf(0), lSizeNeeded, lSizeNeeded)

  If (lResult = 0) Then

    MsgBox "Error: Unable to Get the File Security Descriptor"

    Exit Sub

  End If

lResult = InitializeSecurityDescriptor(sNewSD, SECURITY_DESCRIPTOR_REVISION)

  If (lResult = 0) Then

    MsgBox "Error: Unable to Initialize New Security Descriptor"

    Exit Sub

  End If

  lResult = GetSecurityDescriptorDacl(bSDBuf(0), lDaclPresent, pAcl, lDaclDefaulted)

  If (lResult = 0) Then

    MsgBox "Error: Unable to Get DACL from File Security " & "Descriptor"

    Exit Sub

  End If

  If (lDaclPresent = False) Then

    MsgBox "Error: No ACL Information Available for this File"

    Exit Sub

  End If

  'Attempt to get the ACL from the file's Security Descriptor.

  lResult = GetAclInformation(pAcl, sACLInfo, Len(sACLInfo), 2&)

  If (lResult = 0) Then

    MsgBox "Error: Unable to Get ACL from File Security Descriptor"

    Exit Sub

  End If

However excel crashes at this point when trying to GetAclInformation.  And this is everytime!

So I am slightly lost as to what I can do....can anyone suggest an alternative approach?  Or maybe explain where I am going wrong with the approach I am taking thus far?

Kind Regards and thank you in advance for any suggestions/help

Jonty

Answer 1

Thank you for the link Lizette, I have posted the question there and hopefully by reaching out to as many people as possible I might be able to find someone will have an answer or some thoughts to the matter.

Kind Regards

Jonty

Answer 2

Hi,

We have another forum where Microsoft experts and software developers can assist you. To go to this forum, see this link.

Let us know if you have any other concerns.