Improve company productivity with a Business Account.Sign Up

x
?
Solved

vbscript to add share permissions

Posted on 2009-05-06
8
Medium Priority
?
3,155 Views
Last Modified: 2012-05-06
Hi,
I have a vbscript which creates folders from usernames listed in a text file and then it adds each particular username to the created folders security permissions giving them read and write access.

Because I'm such a noob when it comes to vbscripting and don't have a huge idea about programming, I also want the script to share the newly created folder. Giving share permissions of that being the named folder.
eg. Folder is created call student1 and is shared with share name student1, giving them read and write access.

Is it possible to change the following script to do that?

It would be very muchly appreciated if someone could help out.

Regards


Option Explicit
Dim strHomeFolder, strHome, strUser
Dim objFSO, objShell, intRunError
Dim oFSO, sFile, oFile, sText
 
' Note you will have to amend the following variables
strHome = "D:\Users\"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFile = "D:\Users\users.txt"
 
' Create a shell for cmd and CACLS
Set objShell = CreateObject("Wscript.Shell")
 
' Here is the loop that cycles through the cells
If oFSO.FileExists(sFile) Then
  Set oFile = oFSO.OpenTextFile(sFile, 1)
  Do While Not oFile.AtEndOfStream
    sText = oFile.ReadLine
    If Trim(sText) <> "" Then
      strUser = sText
      call HomeDir ' I decided to use a subroutine
    End If
  Loop
  oFile.Close
Else
  WScript.Echo "The file was not there."
End If
 
 
Sub HomeDir()
  strHomeFolder = strHome & strUser
  If strHomeFolder <> "" Then
    If Not objFSO.FolderExists(strHomeFolder) Then
      On Error Resume Next
      objFSO.CreateFolder strHomeFolder
      If Err.Number <> 0 Then
        On Error GoTo 0
        Wscript.Echo "Cannot create: " & strHomeFolder
      End If
      On Error GoTo 0
    End If
    If objFSO.FolderExists(strHomeFolder) Then
      ' Assign user permission to home folder.
      intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls "_
      & strHomeFolder & " /E /c /g " & strUser & ":C" , 2, True)
      If intRunError <> 0 Then
        Wscript.Echo "Error assigning permissions for user " _
        & strUser & " to home folder " & strHomeFolder
      End If
    End If
  End If
End Sub
 
WScript.Quit

Open in new window

0
Comment
Question by:gotafe
  • 5
  • 3
8 Comments
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24325559
I have made some adjustments to your script.  Try the attached and let me know.

Option Explicit
Dim strHomeFolder, strHome, strUser
Dim objFSO, objShell, intRunError, objWMIService
Dim oFSO, sFile, oFile, strComputer, objShare
 
' Note you will have to amend the following variables
strComputer = "."	' Sets to use current PC
strHome = "D:\Users\"
sFile = "D:\Users\users.txt"
Const FILE_SHARE = 0
Const MAXIMUM_CONNECTIONS = 10	
 
'  Instantiate objects 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Create a shell for cmd and CACLS
Set objShell = CreateObject("Wscript.Shell")
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objShare = objWMIService.Get("Win32_Share")
 
' Here is the loop that cycles through the cells
If oFSO.FileExists(sFile) Then
  Set oFile = oFSO.OpenTextFile(sFile, 1)
  Do While Not oFile.AtEndOfStream
    strUser = oFile.ReadLine
    If Trim(strUser) <> "" Then call HomeDir ' I decided to use a subroutine
  Loop
  oFile.Close
Else
  WScript.Echo "The file was not there."
End If
 
wscript.quit
 
Sub HomeDir()
  strHomeFolder = strHome & strUser
    If Not objFSO.FolderExists(strHomeFolder) Then
      On Error Resume Next
      objFSO.CreateFolder strHomeFolder
      If Err.Number <> 0 Then
        On Error GoTo 0
        Wscript.Echo "Cannot create: " & strHomeFolder
      End If
      On Error GoTo 0
    End If
 
	' Assign user permission to home folder.
	intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls "_
      & strHomeFolder & " /E /c /g " & strUser & ":C" , 2, True)
    If intRunError <> 0 Then
		Wscript.Echo "Error assigning permissions for user " _
        & strUser & " to home folder " & strHomeFolder
    End If
	
	' Share Folder
	' Options are (folderpath, sharename, FileShareflag,
	'	MaximumNumberOfUserConnections, Comments)
	errReturn = objNewShare.Create _
    (strHomeFolder, strUser, FILE_SHARE, _
        MAXIMUM_CONNECTIONS, "My Shared Folder or whatever you want")
	If errReturn <> 0 Then
		wscript.echo "Error sharing " & strHomeFolder
	End if
	
End Sub

Open in new window

0
 

Author Comment

by:gotafe
ID: 24331545
I get an error on Line 59 char 9 saying Error : Object required: 'objNewShare'
Code : 800A01A8, Microsoft VBScript Runtime Error.

It then stops and only creates one folder, but it isn't shared.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24331854
Sorry, had a typo.  Try this code.

-Bear

Option Explicit
Dim strHomeFolder, strHome, strUser
Dim objFSO, objShell, intRunError, objWMIService
Dim oFSO, sFile, oFile, strComputer, objShare
 
' Note you will have to amend the following variables
strComputer = "."       ' Sets to use current PC
strHome = "D:\Users\"
sFile = "D:\Users\users.txt"
Const FILE_SHARE = 0
Const MAXIMUM_CONNECTIONS = 10  
 
'  Instantiate objects 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Create a shell for cmd and CACLS
Set objShell = CreateObject("Wscript.Shell")
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objShare = objWMIService.Get("Win32_Share")
 
' Here is the loop that cycles through the cells
If oFSO.FileExists(sFile) Then
  Set oFile = oFSO.OpenTextFile(sFile, 1)
  Do While Not oFile.AtEndOfStream
    strUser = oFile.ReadLine
    If Trim(strUser) <> "" Then call HomeDir ' I decided to use a subroutine
  Loop
  oFile.Close
Else
  WScript.Echo "The file was not there."
End If
 
wscript.quit
 
Sub HomeDir()
  strHomeFolder = strHome & strUser
    If Not objFSO.FolderExists(strHomeFolder) Then
      On Error Resume Next
      objFSO.CreateFolder strHomeFolder
      If Err.Number <> 0 Then
        On Error GoTo 0
        Wscript.Echo "Cannot create: " & strHomeFolder
      End If
      On Error GoTo 0
    End If
 
        ' Assign user permission to home folder.
        intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls "_
      & strHomeFolder & " /E /c /g " & strUser & ":C" , 2, True)
    If intRunError <> 0 Then
                Wscript.Echo "Error assigning permissions for user " _
        & strUser & " to home folder " & strHomeFolder
    End If
        
        ' Share Folder
        ' Options are (folderpath, sharename, FileShareflag,
        '       MaximumNumberOfUserConnections, Comments)
        errReturn = objShare.Create _
    (strHomeFolder, strUser, FILE_SHARE, _
        MAXIMUM_CONNECTIONS, "My Shared Folder or whatever you want")
        If errReturn <> 0 Then
                wscript.echo "Error sharing " & strHomeFolder
        End if
        
End Sub

Open in new window

0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 

Author Comment

by:gotafe
ID: 24332232
Hi,
Its working, nearly. I had to also go Dim errReturn and declare that variable and it worked.

Whats happening now though, is that the share permissions for each folder is set to 'Everyone' with full control. I want it set to the user instead.  Eg. Folder is created called student1 and is shared as student1 with the share permissions of 'student1' with change permissions.

If that makes any sense.

Regards
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24332829
I am working on the changes but it takes some more code.  I should have something tomorrow.

-Bear
0
 
LVL 20

Accepted Solution

by:
ltlbearand3 earned 2000 total points
ID: 24337013
Ok, I have adjusted the script to set the folder permissions to the username.  Now to set this, the script must have either the domain of the user or the local PC name.  We need this to look up the SID which is required for setting folder permisions (Windows requires that the user being given permisions have been validated as a user).  Just set strUserDomain as your Domain and it should work.  Let me know.

-Bear


Option Explicit
Dim strHomeFolder, strHome, strUser
Dim objFSO, objShell, intRunError, objWMIService
Dim oFSO, sFile, oFile, strComputer, objShare
Dim errReturn, strUserDomain
 
' Note you will have to amend the following variables
strComputer = "."       ' Sets to use current PC
strUserDomain = "DOMAIN"	' Can also put in local machine name
strHome = "D:\Users\"
sFile = "D:\Users\users.txt"
Const FILE_SHARE = 0
Const MAXIMUM_CONNECTIONS = 10  
 
'  Instantiate objects 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Create a shell for cmd and CACLS
Set objShell = CreateObject("Wscript.Shell")
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objShare = objWMIService.Get("Win32_Share")
 
' Here is the loop that cycles through the cells
If oFSO.FileExists(sFile) Then
  Set oFile = oFSO.OpenTextFile(sFile, 1)
  Do While Not oFile.AtEndOfStream
    strUser = oFile.ReadLine
    If Trim(strUser) <> "" Then call HomeDir ' I decided to use a subroutine
  Loop
  oFile.Close
 Else
 	strUser = "EETest"
	CAll HomeDir
 WScript.Echo "The file was not there."
End If
 
wscript.quit
 
Sub HomeDir()
  strHomeFolder = strHome & strUser
    If Not objFSO.FolderExists(strHomeFolder) Then
      On Error Resume Next
      objFSO.CreateFolder strHomeFolder
      If Err.Number <> 0 Then
        On Error GoTo 0
        Wscript.Echo "Cannot create: " & strHomeFolder
      End If
      On Error GoTo 0
    End If
 
	' Share Folder
    SetSharePermission strUserDomain, strUser, strHomeFolder, "HomeFolderShare"
	
	' Assign user permission to home folder.
	intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls "_
      & strHomeFolder & " /E /c /g " & strUser & ":C" , 2, True)
    If intRunError <> 0 Then
                Wscript.Echo "Error assigning permissions for user " _
        & strUser & " to home folder " & strHomeFolder
    End If
End Sub
 
Sub SetSharePermission(strDomain, strFolderName, strPath, strDescription)
	' strFolderName is assumed to be same as username
	Dim objWMISecurity, objDescriptor, objSecurityDesc, objTrustee
	Dim objAccount, objAccountSID, ACE, InParam
 
	Set objWMISecurity = GetObject("winmgmts:" _
		& "{impersonationLevel=impersonate,(Security)}!\\" & strComputer & "\ROOT\CIMV2")
	Set objDescriptor = objWMIService.Get("Win32_SecurityDescriptor")
	Set objSecurityDesc = objDescriptor.SpawnInstance_()
	set objTrustee = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Trustee").Spawninstance_
	set objAccount = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Account.Name='" & strFolderName & "',Domain='" & strDomain &"'")
	set objAccountSID = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_SID.SID='" & objAccount.SID &"'")
	objTrustee.Domain = strDomain
	objTrustee.Name = strFolderName
	objTrustee.Properties_.item("SID") = objAccountSID.BinaryRepresentation
	Set ACE = objWMIService.Get("Win32_Ace").SpawnInstance_
	ACE.Properties_.Item("AccessMask") = 2032127 '2032127 = "Full"; 1245631 = "Change"; 1179817 = "Read"
	ACE.Properties_.Item("AceFlags") = 3
	ACE.Properties_.Item("AceType") = 0
	ACE.Properties_.Item("Trustee") = objTrustee
	objSecurityDesc.Properties_.Item("DACL") = Array(ACE)
	Set InParam = objShare.Methods_("Create").InParameters.SpawnInstance_()
	InParam.Properties_.Item("Access") = objSecurityDesc
	InParam.Properties_.Item("Description") = strDescription
	InParam.Properties_.Item("Name") = strFolderName
	InParam.Properties_.Item("Path") = strPath
	InParam.Properties_.Item("Type") = FILE_SHARE
	InParam.Properties_.Item("MaximumAllowed") = MAXIMUM_CONNECTIONS 
	objShare.ExecMethod_ "Create", InParam
End Sub

Open in new window

0
 

Author Comment

by:gotafe
ID: 24350527
You, sir, are worth your weight in gold.
Its working brilliantly.

Thank you so very very much.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24350550
Your Welcome.
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Welcome, welcome!  If you are new to the series and haven't been following along, please take a brief moment to review the first three installments: Part 1 (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/A_266-VBScri…
This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
Through the video, you can check the migration process of Outlook PST file to PDF. Kernel for Outlook to PDF tool can convert Outlook emails with all attributes like Subject, To, From, Cc, Bcc and other folders such as Inbox, Outbox, Sent Items, Jun…
Watch the video to know the simple way to remove or recover or reset lost or forgotten passwords of Outlook PST file. With Kernel Outlook Password Recovery tool such operation is very easy to perform. It is a freeware with limitation to use with 500…

601 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question