created multiple excel sheets with no duplicates

[Stephon98caffe]

This program reads a file with out of date workstations. The workstations are in different OU and I want to list the workstations by OU's in different Excel sheets. I can not seem to figure out how to create spread sheets for each OU's list of Workstations. I have to be able to create the list on the fly(dymanically). My logic is that I go through file first time to get an array of all OU's so that there are no dublicates. Next I read the file again and want to compare each file entry with list of OU's and put the computer name on the same excel sheet of the OU it is in.
Example Here is the way the data looks. I would like to have a 2 excel sheets. 1 named "NOC" with NOC107 on the list. 2 named "ORM" with AS108DZ8D2-L


"CN=NOC107,OU=Computers,OU=NOC,OU=VACO,DC=dva,DC=va,DC=gov"
"CN=AS108DZ8D21-L,OU=Computers,OU=ORM,DC=dva,DC=va,DC=gov"

Here is my code.


' VB Script Document

Dim objFile, strGuyFile, strFilePath

strFilePath = "c:\temp\outofdate.txt"
'opens file
set objFile = CreateObject("Scripting.FileSystemObject")
set strGuyFile = objFile.OpenTextFile(strFilePath, 1,false)


'***creates excel spreadsheet
Dim intMaxWork, objXL, strMBInfo, strProcInfo, objXLWork
Dim strOU
Dim strCN, i
Dim intRow, diffOU
Dim objCon,strQuery,objRecSet
dim worksheet(2000)
dim single1 (2000)

Const conImpersonate = 3

' create an Excel object and set up the spreadsheet
Set objXL = CreateObject("Excel.Application")
'set objXLWork = objXL.ActiveWorkbook.Worksheets(2)
'objXLWork.Cells(intRow, 1).Value = "job"
'StartExcel objXL
intRow = 1
i = 0


'***Loop parses canonical name of wkst
do while not strGuyFile.AtEndOfStream
line = strGuyFile.ReadLine

arTmp = Split(line, ",")
strCN = Mid(arTmp(0), 5)
strOU = Mid(arTmp(2), 4)

worksheet(i) = strOU
if not strGuyFile.AtEndofStream then
i = i + 1
else
i = i
end if

'UpdateExcel objXL,intRow,strCN, strOU
'intRow = intRow + 1


loop
strGuyFile.Close
strGuyFile.open
'open list again
intRow =1
***Removes dublicates
Dim d, item, thekeys

Set d = CreateObject("Scripting.Dictionary")
d.removeall
d.CompareMode = 0
For Each item In worksheet
If Not d.Exists(item) Then d.Add item, item
Next
thekeys = d.keys


do while not strGuyFile.AtEndOfStream
line = strGuyFile.ReadLine

arTmp = Split(line, ",")
strCN = Mid(arTmp(0), 5)
strOU = Mid(arTmp(2), 4)

'*****LOST****

for each item in thekeys
if not Strcomp(strOU, item) then
Set item = CreateObject("Excel.Application")
StartExcel item
UpdateExcel item,intRow,strCN, strOU
else
UpdateExcel item ,intRow,strCN, strOU
end if


next





'Set d = Nothing





strGuyFile.Close





Sub StartExcel (objXL)

Dim intRow

intRow = 1
objXL.Visible = True
objXL.Workbooks.Add
objXL.Cells(intRow,1).Value = "Computer"
objXL.Cells(intRow,2).Value = "Organization"


objxl.Rows(1).font.Bold = True

End Sub


Sub UpdateExcel(objXL,intRow,strCompName, strOU)

Dim intCounter

WScript.Sleep (1000)
objXL.Cells(intRow,1).Value = strip (strCompName)
objXL.Cells(intRow,2).Value = strOU


End Sub
Function strip (strString)

Dim strOld

strOld = strString
strString = Replace(strString," "," ")
if strOld <> strString then
strString = strip(strString)
End If

strip=strString

End Function

Function StripLineFeed (strString)
If strSTring <> "" then
StripLineFeed = Left(strString,Len(strString)-1)
end if
End Function

 

[PHV]

You may consider a Scripting.Dictionary object to avoid duplicates and thus no need to read the file 2 times.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[Stephon98caffe]

But How would I go about creating spread sheets for each OU?

 

[PHV]

Something like this ?
Set myWS = objXL.ActiveWorkbook.Worksheets.Add()
myWS.Name = "OU name"

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[Stephon98caffe]

now I can do this with each OU? How would I add something to each OU. Or should I say go back in forth. Say I add to ORM spread sheet 2 entries and I need to add something to NOC?

Now is myWS the entire workbook?

Set myWS = objXL.ActiveWorkbook.Worksheets.Add()
myWS.Name = "OU name"

 

[PHV]

objXL.ActiveWorkbook.Worksheets("ORM").Cells(5, 1) = "blah blah from ORM"
objXL.ActiveWorkbook.Worksheets("NOC").Cells(3, 1) = "blah blah from NOC"

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[Stephon98caffe]

Ok I must be doing something wrong. I tried to do a simple example and I get this error

Err: Object required:"ActiveWorkBook'
@ line 6

If I can get the excel sheet to do what I want I think I will be ok.


' VB Script Document
Dim objXL, myWS, strTitle1

Set objXL = CreateObject("Excel.Application")
'***Error right here
Set myWS = objXL.ActiveWorkbook.Worksheets.Add()
myWS.Name = "OU name"

strTitle1 = "OU name"
StartExcel objXL, strTitle1
intRow = 0

intRow = intRow + 1

strCN = "Steven"
strOU = "ITSS"



UpdateExcel objXL,intRow,strCN, strOU


Sub StartExcel (objXL, strTitle)

Dim intRow

intRow = 1
objXL.Visible = True
objXL.Workbooks.Add


objXL.ActiveWorkbook.Worksheets(strTitle).Cells(intRow,1).Value = "Computer"
objXL.ActiveWorkbook.Worksheets(strTitle).Cells(intRow,2).Value = "OU"

objxl.Rows(1).font.Bold = True

End Sub

Sub UpdateExcel(objXL,intRow,strCN, strOU)

Dim intCounter

WScript.Sleep (1000)
objXL.Cells(intRow,1).Value = Strip(strCN)
objXL.Cells(intRow,2).Value = Strip(strOU)


End Sub

Function strip (strString)

Dim strOld

strOld = strString
strString = Replace(strString," "," ")
if strOld <> strString then
strString = strip(strString)
End If

strip=strString

End Function

Function StripLineFeed (strString)
If strSTring <> "" then
StripLineFeed = Left(strString,Len(strString)-1)
end if
End Function

 

[PHV]

You must either create a workbook or open an existing one !
Set objXL = CreateObject("Excel.Application")
objXL.Workbooks.Add
Set myWS = objXL.ActiveWorkbook.Worksheets.Add()
myWS.Name = "OU name"
objXL.Visible = True
...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886