Announcement

Collapse
No announcement yet.

Home Directories Script

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Home Directories Script

    I have the following Script and tweaked it bit, it does everything I need it to do. Except, I am runing this Script on a Windows 2008 server.
    Net Share will only work , if run in the Administrator Command Prompt.
    Does anyone know away around this, so I can run this script without having to run it within the elevated command prompt. It's only the "Net Share" that is causing the issue.

    Thank you

    Code:
    'Option Explicit 
    Dim WshShell, fso, objOU, objUser 
    Set WSHShell = WScript.CreateObject("WScript.Shell") 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set WshNetwork = WScript.CreateObject("WScript.Network") 
    
    DomainName = "My.Domain" ' "DC=My, DC=Domain" 
    Set objOU = GetObject("LDAP://" & DomainName) 
    InputPrompt1 = "Domain = "&DomainName&vbCrLf&"Container = "&OUName&vbCrLf&vbCrLf&"Enter Users Login ID:" 
    UserName = InputBox(InputPrompt1, "UserLoginID") 
     
    Set ProfileServer = fso.GetFolder("F:\export\Home") 
    'Create users home directory 
    If fso.FolderExists(ProfileServer & "\" & UserName) = False Then 
     fso.CreateFolder(ProfileServer & "\" & UCase(UserName)) 
    
    End If 
    
    'Share user home directory 
    
    ShareName = LCase(Username) & "$" 
    FolderName = "U:" & UserName 
    
    'Option Explicit 
    Dim strusername 
    Dim strHomeFolder 
    Dim intRunError, objShell, objFSO 
    Dim oShell 
    strusername = username 
    strHomeFolder = ProfileServer & "\" & UCase(UserName) 
    
    Set objShell = Wscript.CreateObject("Wscript.Shell") 
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Set objNetwork = CreateObject("WScript.Network")
    
    ' Assign user permissions to home directory 
     
         sCMD=("%COMSPEC% /c Echo y|cacls " & strHomeFolder & " /T /E /G " & strusername & ":C") 
         fCMD="%comspec% /c Net Share " & Sharename & "=" & strHomeFolder & " /Grant:" & strusername & ",FULL"     
         WScript.echo fCMD 
         objshell.Run fCMD, 0, True
         WScript.echo sCMD 
         objShell.run sCMD
       If intRunError <> 0 Then 
       Wscript.Echo "Error Assigning Permissions for User" 
       'End If 
       End If 
    
    MsgBox "The creation of user: " & Username & VbCrLf &_ 
    "has completed without error"
    Last edited by Rems; 22nd October 2010, 22:18. Reason: Wrapping code

  • #2
    Re: Home Directories Script - UAC

    If interested, I found a some code that helps running Scripts against the UAC
    http://www.winhelponline.com/article...elevation.html

    Code:
    If WScript.Arguments.length =0 Then
      Set objShell = CreateObject("Shell.Application")
      'Pass a bogus argument with leading blank space, say [ uac]
      objShell.ShellExecute "wscript.exe", Chr(34) & _
      WScript.ScriptFullName & Chr(34) & " uac", "", "runas", 1
    Else
      'Add your code here
    End If


    This works now, it does prompt you to agree to the UAC, then asks for a Valid Username, It then add a Hidden Home Share for the user and provide the proper users rights.

    Code:
    'Option Explicit 
    Dim WshShell, fso, objOU, objUser 
    Set WSHShell = WScript.CreateObject("WScript.Shell") 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set WshNetwork = WScript.CreateObject("WScript.Network") 
     
    If WScript.Arguments.length =0 Then
      Set objShell = CreateObject("Shell.Application")
        'Pass a bogus argument with leading blank space, say [ uac]
        objShell.ShellExecute "wscript.exe", Chr(34) & _
        WScript.ScriptFullName & Chr(34) & " uac", "", "runas", 1
     Else
    DomainName = "My.Domainl" ' "DC=My, DC=Domainl" 
    Set objOU = GetObject("LDAP://" & DomainName) 
    InputPrompt1 = "Domain = "&DomainName&vbCrLf&"Container = "&OUName&vbCrLf&vbCrLf&"Enter Users Login ID:" 
    UserName = InputBox(InputPrompt1, "UserLoginID") 
     
    Set ProfileServer = fso.GetFolder("F:\export\Home") 
    'Create users home directory 
     
    
    If fso.FolderExists(ProfileServer & "\" & UserName) = False Then 
     fso.CreateFolder(ProfileServer & "\" & UCase(UserName)) 
    
    End If 
    
    'Share user home directory 
    
    ShareName = LCase(Username) & "$" 
    
    'Option Explicit 
    Dim strusername 
    Dim strHomeFolder 
    Dim intRunError, objShell, objFSO 
    Dim oShell 
    strusername = username 
    strHomeFolder = ProfileServer & "\" & UCase(UserName) 
    
    Set objShell = Wscript.CreateObject("Wscript.Shell") 
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Set objNetwork = CreateObject("WScript.Network")
    
    ' Assign user permissions to home directory 
     
         sCMD=("%COMSPEC% /c Echo y|cacls " & strHomeFolder & " /T /E /G " & strusername & ":C") 
         fCMD="%comspec% /c Net Share " & Sharename & "=" & strHomeFolder & " /Grant:" & strusername & ",FULL"     
         WScript.echo fCMD 
         
     objshell.Run fCMD 
     
     
         WScript.echo sCMD 
         objShell.run sCMD
       If intRunError <> 0 Then 
       Wscript.Echo "Error Assigning Permissions for User" 
       'End If 
       End If 
    MsgBox "The creation of user: " & Username & VbCrLf &_ 
    "has completed without error" 
    End If
    Last edited by Rems; 22nd October 2010, 22:19. Reason: Wrapping code

    Comment

    Working...
    X