Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Duplicated Data

Status
Not open for further replies.
cparralesl

cparralesl

Programmer
Jan 27, 2002
118
NI
Hi Guys,

The Script below Supposes to make Software Inventory remotly. The Script takes the PC name from a file previously, then, it get connected to the computer and search for the software installed and some other information and place it into a Excel sheet. There are some cumputer with Windows 7 Operating System Installed in the Domain.

The problem i'm having is that some users appears to be logged in differents PCs, according to the final report. When I get there check to confirm that, the user logged is not what the report shows.

As you can see, the creation of computer list appers twice. That because I could not call a procedure. Help there will be appreciated too.

Can any one give me some help to get over this behavior?

Code: 
On Error Resume Next
Const Enterprise= "Servicios Informaticos"

Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists ("PCListNI.txt") Then
     Resp = MsgBox ("Do you want to recreate Work Stations file? " & VbCrLf & _
               "The process might take severals minutes", VbYesNo + VbQuestion, Enterprise)

     If Resp = VbYes Then
          Set Partitions = GetObject("LDAP://CN=Partitions,CN=Configuration," & GetObject("LDAP://RootDSE").Get("DefaultNamingContext"))
          For Each Partition In Partitions
               strDomain = Partition.Get("nETBIOSName")
               If Err.Number = 0 then Exit For
          Next
          Set Partitions = Nothing

          ' connect to the computer.
          Set objIADsContainer = GetObject("WinNT://" & strDomain)

          'set the filter to retrieve only objects of class Computer
          objIADsContainer.Filter = Array("Computer")

          For Each objIADsComputer In objIADsContainer
               If (Left(objIADsComputer.Name,5)="FESEL") Then
                    report = report & objIADsComputer.Name & vbCrLf
               End If
          Next

          Set fso = CreateObject("Scripting.FileSystemObject")
	  fso.DeleteFile("PCListNI.txt")
          Set ts  = fso.CreateTextFile ("PCListNI.txt", ForWriting)
          ts.write report
	  ts.Close

          Set ts = Nothing
          Set fso = Nothing
          Set objIADsComputer = Nothing
          Set objIADsContainer = Nothing

	  xResp = MsgBox ("The file was created. Do you want to continue?", VbYesNo + VbQuestion, Enterprise)
	  If xResp = VbNo Then
	     Wscript.Quit
	  End If

     Else
          MsgBox "The process will take the current Work Stations File", VbOkOnly + VbInformation, Enterprise
     End If
Else
     Resp = MsgBox ("The Work Stations file doesn't exists. It will proceed to generate it." & VbCrLf & _ 
            "The process might take severals minutes..." & VbCrLf & _
            "Do you want to continue?", VbYesNo + VbInformation, Enterprise)
     If Resp = VbYes Then
          
          Set Partitions = GetObject("LDAP://CN=Partitions,CN=Configuration," & GetObject("LDAP://RootDSE").Get("DefaultNamingContext"))
          For Each Partition In Partitions
               strDomain = Partition.Get("nETBIOSName")
               If Err.Number = 0 then Exit For
          Next
          Set Partitions = Nothing

          ' connect to the computer.
          Set objIADsContainer = GetObject("WinNT://" & strDomain)

          'set the filter to retrieve only objects of class Computer
          objIADsContainer.Filter = Array("Computer")

          For Each objIADsComputer In objIADsContainer
               If (Left(objIADsComputer.Name,5)="FESEL") Then
                    report = report & objIADsComputer.Name & vbCrLf
               End If
          Next

          Set fso = CreateObject("Scripting.FileSystemObject")
          Set ts  = fso.CreateTextFile ("PCListNI.txt", ForWriting)
          ts.write report
	  ts.Close

          Set ts = Nothing
          Set fso = Nothing
          Set objIADsComputer = Nothing
          Set objIADsContainer = Nothing

	  xResp = MsgBox ("The file was created. Do you want to continue?", VbYesNo + VbQuestion, Enterprise)
	  If sResp = VbNo Then
	     Wscript.Quit
	  End If

     Else
          MsgBox "Inventory process cancelled", VbInformation + VbOkOnly, Enterprise
          Wscript.Quit
     End If
End If

'open the file system object
Set oFSO = CreateObject("Scripting.FileSystemObject")
set WSHShell = wscript.createObject("wscript.shell")

'Open the data file
Set oTextStream = oFSO.OpenTextFile("PCListNI.txt")

'make an array from the data file
RemotePC = Split(oTextStream.ReadAll, vbNewLine)

'close the data file
oTextStream.Close

Set Xlls = CreateObject("Excel.Application")
Set Wkbk = Xlls.Workbooks.Add

I=2
Xlls.Application.Visible = True
Wkbk.Worksheets(1).name = "Computers"
Wkbk.Worksheets(1).cells(1,1).Value = "PC Name"
Wkbk.Worksheets(1).cells(1,2).Value = "User Name"
Wkbk.Worksheets(1).cells(1,3).Value = "Domain"
Wkbk.Worksheets(1).cells(1,4).Value = "System Type"
Wkbk.Worksheets(1).cells(1,5).Value = "Operating System"
Wkbk.Worksheets(1).cells(1,6).Value = "Version"
Wkbk.Worksheets(1).cells(1,7).Value = "Registered User"
Wkbk.Worksheets(1).cells(1,8).Value = "Manufacturer"
Wkbk.Worksheets(1).cells(1,9).Value = "Encryption Level"
Wkbk.Worksheets(1).cells(1,10).Value = "Organization"
Wkbk.Worksheets(1).cells(1,11).Value = "Software Installed"
Wkbk.Worksheets(1).cells(1,12).Value = "Software Version"
Wkbk.Worksheets(1).cells(1,13).Value = "Software Manufacturer"
Wkbk.Worksheets(1).cells(1,14).Value = "Installed Date"
Wkbk.Worksheets(1).cells(1,15).Value = "System Serial Nº"
Wkbk.Worksheets(1).cells(1,16).Value = "SAsset Tag"
Wkbk.Worksheets(1).Range("A1:P1").Font.Bold = True

For Each strComputer In RemotePC

   strPingStatus = PingStatus(strComputer)

   If strPingStatus = "Success" Then

      Set objWMIService = GetObject("winmgmts:" & _
          "{impersonationLevel=impersonate}!\\" & _
          strComputer & _
          "\root\cimv2")


      'Requestiong PC System Information
      '==========================================
      Set colItems = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
      For Each objItem in colItems
          CSPCName = strComputer 'objItem.Name
          CSUSName = objItem.UserName
          CSDmName = objItem.Domain
          CSSysTyp = objItem.SystemType
      Next


      'Requesting OS Information
      '==============================================
      Set objOSItems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
      For Each objOS in objOSItems
          OSCaption = objOS.Caption
          OSVersion = objOS.Version
          OSRegUser = objOS.RegisteredUser
          OSManufac = objOS.Manufacturer
          OSEncLevl = objOS.EncryptionLevel 
          OSOrganiz = objOS.Organization
      Next


      'Requesting Asset Information
      '=======================================
      Set objSEItems = objWMIService.ExecQuery ("Select * from Win32_SystemEnclosure")
      For Each objSE in objSEItems
          SECSerialN = objSE.SerialNumber
          SEAssetTag = objSE.SMBIOSAssetTag
      Next


      'Requesting IP Address
      '=======================================
      Set objIPItems = objWMIService.ExecQuery ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
      For Each objIP in objIPItems
         If isNull(objIP.IPAddress) Then
            IPNumber = ""
         Else
            IPNumber = Join(objIP.IPAddress, ",")
         End If          
      Next


      'Requesting Software Installed
      '===============================================
      'Set objWMIService = GetObject("winmgmts:\\" & strComputer & "root\CIMV2")
      Set colObjSW = objWMIService.ExecQuery("SELECT * FROM Win32Reg_AddRemovePrograms",,48)

      For Each objItem in colObjSW
         If (InStr(objItem.DisplayName,"KB")= False) And _
            (InStr(objItem.DisplayName,"Service Pack")= False) And _
            (InStr(objItem.DisplayName,"Security Update")= False) Then
               Wkbk.Worksheets(1).cells(I,1).Value  = CSPCName
               Wkbk.Worksheets(1).cells(I,2).Value  = CSUSName
               Wkbk.Worksheets(1).cells(I,3).Value  = CSDmName
               Wkbk.Worksheets(1).cells(I,4).Value  = CSSysTyp
               Wkbk.Worksheets(1).cells(I,5).Value  = OSCaption
               Wkbk.Worksheets(1).cells(I,6).Value  = OSVersion
               Wkbk.Worksheets(1).cells(I,7).Value  = OSRegUser
               Wkbk.Worksheets(1).cells(I,8).Value  = OSManufac
               Wkbk.Worksheets(1).cells(I,9).Value  = OSEncLevl
               Wkbk.Worksheets(1).cells(I,10).Value = OSOrganiz
               Wkbk.Worksheets(1).cells(I,11).Value = objItem.DisplayName
               Wkbk.Worksheets(1).cells(I,12).Value = objItem.Version
               Wkbk.Worksheets(1).cells(I,13).Value = objItem.Publisher
               Wkbk.Worksheets(1).cells(I,14).Value = objItem.InstallDate
               Wkbk.Worksheets(1).cells(I,15).Value = SECSerialN
               Wkbk.Worksheets(1).cells(I,16).Value = SEAssetTag
               Wkbk.Worksheets(1).cells(I,17).Value = IPNumber
               I=I+1
         End If
      Next
   Else
      Wkbk.Worksheets(1).cells(I,1).Value  = strComputer
      For K=2 To 17
         Wkbk.Worksheets(1).cells(I,K).Value  = strComputer & "PC Not Available"
      Next K
      I=I+1
   End If

Next

MsgBox "Done!", VbOkOnly + VbInformation, Enterprise

Set Wkbk	= Nothing
Set Xlls	= Nothing
Set oTextStream	= Nothing
set WSHShell	= Nothing
Set oFSO	= Nothing


Function PingStatus(strComputer)
    'On Error Resume Next
        
    Set objWMIService = GetObject("winmgmts:" _
      & "{impersonationLevel=impersonate}!\\" & strComputer & "\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



Cesar Humberto Parrales
Application Support
 
Sort by date Sort by votes
Hi,

Thanks for you response tsuji,

I put the "On Error Resume Next" away from the first line. After that, I run it and show up an error message saying: "The WorkSation is unavailable". The error message point the line in the PingStatus Function that says:

Code: 
    Set objWMIService = GetObject("winmgmts:" _
      & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

If I uncomnent the "On Error Resume Next" in the PingStatus function, then it pass through, but it return an empty string. It should return Status code along " - Unable to determine cause of failure." at least.

The help regarding will be appreciated,

Thanks


Cesar Humberto Parrales
Application Support
 
Upvote 0 Downvote
>Set colPings = objWMIService.ExecQuery _
("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")

Under some circumstances colPings does not get created and the For Each does not loop; you must handle that. My rems in some related vb6 code say 'can happen if the target computer has changed its IP address'

I suggest you set a flag inside the loop and test its value after after the loop to see if the loop was entered.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

asel
  • Locked
  • Question
Copy cell data from excel and paste into portable software application
Replies
0
Views
166
asel
asel
shilpa2002
  • Locked
  • Question
how to copy data from two excel workbooks into third. merging data based on common field
Replies
3
Views
232
SkipVought
S
joaodaffonsojr
  • Locked
  • Question
vbscript import xml data to excel
Replies
0
Views
144
joaodaffonsojr
joaodaffonsojr
TomFra
  • Locked
  • Question
OCR Zoning - Field data for auto-sorting is not being considered in 1 of 2 possible cases. 1
Replies
9
Views
298
TomFra
TomFra
jscharfenberg
  • Locked
  • Question
Help with VBS script to pull data and make into XML for Dayforce import
Replies
0
Views
85
jscharfenberg
jscharfenberg

Part and Inventory Search

Sponsor

Back
Top