Link to home
Start Free TrialLog in
Avatar of ITdd
ITdd

asked on

VBscript will run as current user in Excel but not launched seperately

I have a script I can run just fine in Excel VB as a very limited user but that user can't just click on the VBS and it run. As an admin I can't make it run on the server either.

Ultimate goal is to have it as a logon script in AD which I did but it didn't work so I've traced it back to the previous reality. When I try to just run it on the server a Open File Security Warning comes up to which I click open but then nothing happens.

The script ultimately looks through nested group membership and publishes an icon on a terminal server if the user is a member of a certain group. The terminal server is fairly locked down but why does it run in Excel and not stand alone?
Option Explicit
'I've replaced our domain name with the word "domain"
 
'Because these variables are defined at the top of the script, out side of functions and sub routines
 
'They are visible and usuable by all the funtions and subs contained in the script.
 
'Conversely, variables defined inside of a sub or function are only visable inside the sub or function.
 
 
 
Dim objNetwork
 
Dim objSysInfo
 
Dim strUserDN
 
Dim objGroupList
 
Dim objUser    'this will later be set to be = to a user, with all of a users parameters held within.
 
Dim objFSO
 
Dim strComputerDN
 
Dim objComputer   'this will later be set to = the computer on which the script is running, with all of the parameters held within.
 
Dim filesys
 
Dim objClass
 
Dim strProfilePath
 
 
 
 
 
 
 
Sub Macro1()
 
 
 
Set objNetwork = CreateObject("Wscript.Network")
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
Set objSysInfo = CreateObject("ADSystemInfo")
 
Set filesys = CreateObject("Scripting.FileSystemObject")
 
 
 
 
 
 
 
 
 
strUserDN = objSysInfo.UserName
 
strComputerDN = objSysInfo.computerName
 
 
 
' Escape any forward slash characters, "/", with the backslash
 
' escape character. All other characters that should be escaped are.
 
 
 
'Escape characters are characters used to tell the system that the next character is a special
 
'character and to not 'interpret it literally.
 
'e.g...how would you tell the system about a quote mark ?  after all, you use quote marks in code already.
 
'You do it with an escape character.  The escape character for a quote mark is a quote mark.
 
'So, a single quote mark in code looks like this: """".
 
 
 
strUserDN = Replace(strUserDN, "/", "\/")
 
strComputerDN = Replace(strComputerDN, "/", "\/")
 
 
 
' Bind to the user and computer objects with the LDAP provider.
 
 
 
Set objUser = GetObject("LDAP://" & strUserDN)
 
Set objComputer = GetObject("LDAP://" & strComputerDN)
 
 
 
 
 
 
 
Dim WshShell
 
Dim WshSysEnv
 
Set WshShell = CreateObject("WScript.Shell")
 
Set WshSysEnv = WshShell.Environment("PROCESS")
 
 
 
'This is the path  you want.
 
'strProfilePath = WshSysEnv("USERPROFILE") & "\Desktop\"
 
strProfilePath = "\\domain\redirected$\" & objUser.sAMAccountName & "\desktop\"
 
 
 
Dim strFrom
 
Dim strTo
 
 
 
' Copy a shortcut if the user is a member of the group.
 
 
 
If (IsMember(objUser, "CateringGroups") = True) Then
 
 
 
    filesys.CopyFile "\\domain\deploy$\DesktopIcons\icon.lnk", strProfilePath
 
    
 
End If
 
 
 
 
' Clean all of these variables out of memory.  Not required in c# and others, but VBS does not
 
' garbage collect automatically so you have to manually kill the varaibles to free the memory.
 
 
 
Set objNetwork = Nothing
 
Set objFSO = Nothing
 
Set objSysInfo = Nothing
 
Set objGroupList = Nothing
 
Set objUser = Nothing
 
Set objComputer = Nothing
 
 
 
 
 
End Sub
 
 
 
Function IsMember(ByVal objADObject, ByVal strGroup)
 
 
 
    ' Function to test for group membership.
 
    ' objGroupList is a dictionary object with global scope.
 
 
 
    If (IsEmpty(objGroupList) = True) Then
 
        Set objGroupList = CreateObject("Scripting.Dictionary")
 
    End If
 
 
 
    If (objGroupList.Exists(objADObject.sAMAccountName & "\") = False) Then
 
        Call LoadGroups(objADObject, objADObject)
 
        objGroupList.Add objADObject.sAMAccountName & "\", True
 
    End If
 
 
 
    IsMember = objGroupList.Exists(objADObject.sAMAccountName & "\" & strGroup)
 
 
 
End Function
 
 
 
 
 
Sub LoadGroups(ByVal objPriObject, ByVal objADSubObject)
 
 
 
    ' Recursive subroutine to populate dictionary object objGroupList.
 
    ' A dictionary object is nothing more than an array with special built in functions for looking stuff up.
 
 
 
    Dim colstrGroups, objGroup, j
 
    objGroupList.CompareMode = vbTextCompare
 
    colstrGroups = objADSubObject.memberOf
 
 
 
    If (IsEmpty(colstrGroups) = True) Then
 
 
 
        Exit Sub
 
 
 
    End If
 
 
 
    If (TypeName(colstrGroups) = "String") Then
 
 
 
        ' Escape any forward slash characters, "/", with the backslash
 
        ' escape character. All other characters that should be escaped are.
 
 
 
        colstrGroups = Replace(colstrGroups, "/", "\/")
 
        Set objGroup = GetObject("LDAP://" & colstrGroups)
 
        If (objGroupList.Exists(objPriObject.sAMAccountName & "\" & objGroup.sAMAccountName) = False) Then
 
            objGroupList.Add objPriObject.sAMAccountName & "\" & objGroup.sAMAccountName, True
 
            Call LoadGroups(objPriObject, objGroup)
 
        End If
 
        
 
        Set objGroup = Nothing
 
        
 
        Exit Sub
 
 
 
    End If
 
 
 
    For j = 0 To UBound(colstrGroups)
 
 
 
        ' Escape any forward slash characters, "/", with the backslash
 
        ' escape character. All other characters that should be escaped are.
 
 
 
        colstrGroups(j) = Replace(colstrGroups(j), "/", "\/")
 
        Set objGroup = GetObject("LDAP://" & colstrGroups(j))
 
        If (objGroupList.Exists(objPriObject.sAMAccountName & "\" & objGroup.sAMAccountName) = False) Then
 
            objGroupList.Add objPriObject.sAMAccountName & "\" & objGroup.sAMAccountName, True
 
            Call LoadGroups(objPriObject, objGroup)
 
        End If
 
 
 
    Next
 
    Set objGroup = Nothing
 
 
 
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Wikkard
Wikkard
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of ITdd
ITdd

ASKER

Sorry, I was out on vacation. Unfortunately I don't think the link coincides.
Ultimately I'm looking to run a script at logon that copies appropriate icons to the desktop. Can anyone help?
Sorry I didnt get a chance to follow up on this question.

Do you still need help ?
Avatar of ITdd

ASKER

I didn't try this, but am convinced it is a permissions issue. I did a different more basic script for the logon rather than invest more time on this.