System enviroment variables over the network..Code issue

[hannable80]

Hi,

I am having a problem with the below code. Basicaly the issue is that the code works fine on a local PC but when i try to use it to change a remote machines.


dim WshShell
dim WshSysEnv
dim Path
dim PathToAdd


set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True



Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"


' Format the cell A1 and add the text: Service


Set objCOmmand.ActiveConnection = objConnection
objCommand.CommandText = _
"Select Name, Location from 'LDAP://xxxxxx' " _
& "Where objectClass='Computer'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute



objExcel.Workbooks.Add


objExcel.Cells(1, 1).Value = "Ping"

objExcel.Cells(1, 1).Font.Bold = TRUE

objExcel.Cells(1, 1).Interior.ColorIndex = 43

objExcel.Cells(1, 1).Font.ColorIndex = 2



' Format the cell A1 and add the text: Status

objExcel.Cells(1, 2).Value = "Model"

objExcel.Cells(1, 2).Font.Bold = TRUE

objExcel.Cells(1, 2).Interior.ColorIndex = 50

objExcel.Cells(1, 2).Font.ColorIndex = 2



' Format the cell A1 and add the text: Status

objExcel.Cells(1, 3).Value = "Computer"

objExcel.Cells(1, 3).Font.Bold = TRUE

objExcel.Cells(1, 3).Interior.ColorIndex = 49

objExcel.Cells(1, 3).Font.ColorIndex = 2


x = 1
'==================================================================Ping function=====================================================
Function PingStatus(strComputer)

On Error Resume Next
strWorkstation = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strWorkstation & "\root\cimv2")
Set colPings = objWMIService.ExecQuery _
("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
For Each objPing in colPings
Select Case objPing.StatusCode
Case 0 PingStatus = "Success"
Case 11001 PingStatus = "Status code 11001 - Buffer Too Small"
Case 11002 PingStatus = "Status code 11002 - Destination Net Unreachable"
Case 11003 PingStatus = "Status code 11003 - Destination Host Unreachable"
Case 11004 PingStatus = _
"Status code 11004 - Destination Protocol Unreachable"
Case 11005 PingStatus = "Status code 11005 - Destination Port Unreachable"
Case 11006 PingStatus = "Status code 11006 - No Resources"
Case 11007 PingStatus = "Status code 11007 - Bad Option"
Case 11008 PingStatus = "Status code 11008 - Hardware Error"
Case 11009 PingStatus = "Status code 11009 - Packet Too Big"
Case 11010 PingStatus = "Status code 11010 - Request Timed Out"
Case 11011 PingStatus = "Status code 11011 - Bad Request"
Case 11012 PingStatus = "Status code 11012 - Bad Route"
Case 11013 PingStatus = "Status code 11013 - TimeToLive Expired Transit"
Case 11014 PingStatus = _
"Status code 11014 - TimeToLive Expired Reassembly"
Case 11015 PingStatus = "Status code 11015 - Parameter Problem"
Case 11016 PingStatus = "Status code 11016 - Source Quench"
Case 11017 PingStatus = "Status code 11017 - Option Too Big"
Case 11018 PingStatus = "Status code 11018 - Bad Destination"
Case 11032 PingStatus = "Status code 11032 - Negotiating IPSEC"
Case 11050 PingStatus = "Status code 11050 - General Failure"
Case Else PingStatus = "Status code " & objPing.StatusCode & _
" - Unable to determine cause of failure."
End Select
Next

End Function

'----------------------------------------------------------------------------------------------



'===========================================================Write each service to Excel, starting in A2
Do Until objRecordSet.EOF
' ` services on this computer
on error resume next
strComputer = objRecordSet.Fields("Name").Value
'Sets the compter name

Set colItems = objWMIService.ExecQuery("SELECT * FROM " _
& "Win32_ComputerSystem", "WQL", wbemFlagReturnImmediately _
+ wbemFlagForwardOnly )

Set WshShell1 = CreateObject("WScript.Shell")
' makes environment settings permanent
Set WshSystemUser = WshShell1.Environment("USER")
' Set environment variable
WshSystemUser("Path") = "P:\SAR\Deploy21"

Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("SYSTEM")
Path = WshSysEnv("PATH")
PathToAdd = "P:\SAR\Deploy41"

'MsgBox Path
If Not (InStr(1, Path, PathToAdd & ";") Or Right(Path, Len(PathToAdd)) = PathToAdd) Then 'If it already exists, don't add it again
If Right(Path, 1) <> ";" Then Path = Path & ";" 'check for semi colon at the end
Path = Path & PathToAdd
'MsgBox Path
WshSysEnv.Item("PATH") = Path
End If
For Each objItem in colItems
x = x + 1
strPingStatus = PingStatus(strComputer)
If strPingStatus = "Success" Then

objExcel.Cells(x, 1) = "Success"

objExcel.Cells(x, 2) = objItem.Model

objExcel.Cells(x, 3) = objRecordSet.Fields("Name").Value



end if

NEXT

objRecordSet.MoveNext


loop

 

[mrmovie]

'i am not sure what you are doing with the
Set WshSysEnv = WshShell.Environment("SYSTEM")
Path = WshSysEnv("PATH")
PathToAdd = "P:\SAR\Deploy41
'but if you want to action this on the remote machines then you wont be able to use WshShell directly like this, you will need to update remote registry using WMI or manipulate WMI on the remote machine, but im not sure which class deals with environment variables, (i do have WMI code somwehre to do it, but cant recall the class)

it would appear that you need one instance of the objWMIService which is for your local machine to use in the PingStatus and the other you bind to based on strComputer,

i would do something like:


Set objLocalWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\.\root\cimv2")
'and use this one to call the PingStatus stuff, i.e. dont have the creation of the objWMIService in the PingStatus anymore, it is wasteful and time consuming to create and destroy this object on your local machine for each target machine...

Do Until objRecordSet.EOF
' ` services on this computer
'on error resume next
strComputer = objRecordSet.Fields("Name").Value
'Sets the compter name
Call PingStatus(strComputer, objLocalWMIService)
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM " _
& "Win32_ComputerSystem", "WQL", wbemFlagReturnImmediately _
+ wbemFlagForwardOnly )
'do some sort of manip on target WMI instance?

 

[hannable80]

Okay i see now. How do i manipulate the user variables for the user in the system enviroment variables.

Thanks

 

[hannable80]

So basicaly i have changed my script to WMI standard, I can append data to the enviroment variable but cannot create a new user enviroment variable.... Can any one come up with a way how to do this?> cannot find anything on the web!!!HELP


Option Explicit
On Error Resume Next

Dim objReg, strComputer, strValueRight, strValueLeft
Dim strSearchFor, strKeyPath, strEntryName, strValue, Path
Dim strTotalLength, strSearchForLength, strStartAt
dim strArraySearchFor

Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
' Each value in the Array must end with a semicolon ";"
strArraySearchFor=Array("c:\log;", "c:\logs;")
' WMI Section which connects to registry (StdRegProv)
' Gets value for strValue (GetExpandedStringValue)
Set objReg=GetObject _
("winmgmts:{impersonationLevel=impersonate,(Security)}!\\" _
& strComputer & "\root\default:StdRegProv")
PathToAdd = "P:xx"
strKeyPath = "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"
strEntryName = "path"
objReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath, _
strEntryName,strValue
If Not (InStr(1, strValue, PathToAdd & ";") Or Right(strValue, Len(PathToAdd)) = PathToAdd) Then 'If it already exists, don't add it again
If Right(strValue, 1) <> ";" Then strValue = strValue & ";" 'check for semi colon at the end
strValue = strValue & PathToAdd
'MsgBox Path
WshSysEnv.Item("PATH") = strValue
end if
' this part is not working

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objVariable = objWMIService.ExecQuery("Select * from Win32_Environment")
objVariable.UserName = "Wreck"
objVariable.VariableValue = "Wreck"
objVariable.Put_

 

[mrmovie]

'check this out...(it might be flawed but i know it creates them

Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
Set colVars = objWMI.InstancesOf("Win32_Environment")
For Each aVar in colVars
If UCase(strVarName) = UCase(aVar.Name) Then
Wscript.Echo "we have a match on name " & aVar.Name
If UCase(strUserName) = UCase(aVar.UserName) Then
'ok we have a match,,therefore we need to update it
Wscript.Echo "we have a match on username " & aVar.UserName & " as well"
If blnOverWrite = True Then
'sgbox "overwrite"
aVar.variableValue = strValue
aVar.Put_
Else
aVar.variableValue = aVar.variableValue & ";" & strValue
aVar.Put_
End If
blnFound = True
Exit For
End If
End If
Next
Set colVars = Nothing
Set objWMI = Nothing

If blnFound = False Then
'perhaps it doesnt exist?
Set objVarClass = GetObject("winmgmts:\\.\root\cimv2:Win32_Environment")
Set aVar = objVarClass.SpawnInstance_
aVar.Name = strVarName
aVar.VariableValue = strValue
aVar.UserName = strUserName
aVar.Put_
Set aVar = Nothing
Set objVarClass = Nothing
End If

 

[hannable80]

no dice i can get the environment variable ok but i cant enter the user name variable

 

[hannable80]

crisis averted

http://www.tek-tips.com/faqs.cfm?fid=5755

 

[mrmovie]

'do you mean you are using this to set user specific environment variables remotely as you presented earlier?
Set objShell = WScript.CreateObject("WScript.Shell")
Set objEnv = objShell.Environment("User")
'unless i have been mistaken for a while now you wont be able to achieve this using Wscript.Shell on a remote machine...