Announcement

Collapse
No announcement yet.

modify vbs

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

  • modify vbs

    I have a script that reads from a .ldf file, and sorts the data out into a text file. Here is the format it reads from:


    Code:
    CN=Lastname\, Firstname,OU=Users,OU=sports group,DC=domain,DC=name, DC=com
    This code will read the data and sort it:


    Code:
    Dim objFileSystem, objInputFile
    Dim strOutputFile, inputData, strData, strTemp
    
    Const OPEN_FILE_FOR_READING = 1
    
    ' generate a filename base on the script name, here readfile.in
    strOutputFile = "groups.ldf"
    
    Set objFileSystem = CreateObject("Scripting.fileSystemObject")
    Set objInputFile = objFileSystem.OpenTextFile(strOutputFile, OPEN_FILE_FOR_READING)
    
    ' read everything in an array
    inputData = Split(objInputFile.ReadAll, vbNewline)
    
    For each strData In inputData
           if Mid(strData, 1,2)="me" and len(strdata)>10  then
           strTemp=Mid(strData, 12, InStr(1, strData,",",1)-12)
    
    WScript.Echo strTemp
    
    end if  
    
        if Mid(strData,1,2)=" C" then
    
    strTemp=Mid(strData, 5, InStr(1, strData,",",1)-5)
    
    WScript.Echo strTemp  
    end if
    
    Next
    
    objInputFile.Close
    Set objFileSystem = Nothing
    
    WScript.Quit(0)
    In the text file it looks like this:

    Lastname\

    How would I modify the code to make the output "Lastname, Firstname" instead of "Lastname\"? I don't know where to start to edit this.

    Thanks to anyone who can help...

  • #2
    Re: modify vbs

    I believe I would need to change this line...

    Code:
     if Mid(strData,1,2)=" C" then
    
    strTemp=Mid(strData, 5, InStr(1, strData,",",1)-5)

    Comment


    • #3
      Re: modify vbs

      Use the Replace() function.

      - Read the lines in to a Array Splitted into rows
      - empty the origional file, before writing the modified rows back
      - For each Row:
      1st, Replace "\," with just a "," this will clean the \
      2nd, Replace "CN=" with nothing ""
      3rd, Replace ",space" with just a "," this will clean the spaces after each comma.
      4th, append the row to the file

      Code:
      Dim objFileSystem, objInputFile
      Dim strOutputFile, inputData, strData, strTemp
      
      Const ForReading   = 1
      Const ForWriting   = 2
      Const ForAppending = 8
      
      ' generate a filename base on the script name, here readfile.in
      strOutputFile = "groups.ldf"
      
      Set objFileSystem = CreateObject("Scripting.fileSystemObject")
      
      ' Stream the FILE content into an array
      ' same time Break the array into rows at line breaks
      Set objInputFile = objFileSystem.OpenTextFile(strOutputFile, ForReading)
      inputData = Split(objInputFile.ReadAll, vbNewline)
      objInputFile.Close
      
      'Erase the origional FILE content
      Set objInputFile = objFileSystem.OpenTextFile(strOutputFile, ForWriting, False)
        objInputFile.Close 
      
      ' modify each row and write back to the FILE
      Set objInputFile = objFileSystem.OpenTextFile(strOutputFile, ForAppending, True)
      For Each strData In inputData
        strData = Replace(strData, "\,", ",")
        strData = Replace(strData, "CN=", "")
        strData = Replace(strData, ", ", ",")
        objInputFile.WriteLine(strData)
      Next
      
      objInputFile.Close      
       
      Set objFileSystem = Nothing
      
      WScript.Quit
      \Rems
      Last edited by Rems; 12th June 2007, 22:47. Reason: replace also the spaces after each comma

      This posting is provided "AS IS" with no warranties, and confers no rights.

      __________________

      ** Remember to give credit where credit's due **
      and leave Reputation Points for meaningful posts

      Comment


      • #4
        Re: modify vbs

        Thanks, that would work to update the .ldf file...but I am actually outputting it to an excel file. The first part of the script that I failed to mention is this:


        Code:
        Set objShell = CreateObject("Wscript.Shell")
        objShell.Run("%comspec% /c ldifde -f groups.ldf -s domain -d ""CN=group,OU=ou,DC=domain,DC=domain,DC=com"" -l ""member"""), 0, True
        objShell.Run("%comspec% /c cscript  Modify.vbs > ""Users.xls"""), 0, True
        
        '----------------------------------------------------------EXCEL:
        
            Set objExcel = CreateObject("Excel.Application")
        	objExcel.Application.DisplayAlerts = False
        	objExcel.Visible = False
        
            Set objWorkbook = objExcel.Workbooks.Open("C:\Documents and Settings\ekrengel\Desktop\Scripts\VBS LDIFDE AD EXPORT MEMBERS-DISTIBUTION\Users.xls")
        	
        	objExcel.ActiveSheet.Rows("1:2").Delete 
        	
        	objExcel.Range("A1:I1").Select
        	objExcel.Selection.Font.Bold = True
        	objExcel.Selection.Font.Size = 11
        	objExcel.Selection.Interior.ColorIndex = 11 
        	objExcel.Selection.Interior.Pattern = 1 'xlSolid 
        	objExcel.Selection.Font.ColorIndex = 2
        	objExcel.Selection.WrapText = True
        
        	objExcel.Cells(1,1).Value = "Lastname"
        	objExcel.Cells(1,2).Value = "Firstname"
        
        	objExcel.Columns("A:I").Select
        	objExcel.Selection.HorizontalAlignment = 3 'xlCenter
        	objExcel.Selection.Borders.LineStyle = 1 '= xlSolid
        
        	'autofits all the colums
        	objExcel.Columns("A:AH").EntireColumn.AutoFit
        	
            objExcel.ActiveWorkbook.SaveAs("C:\Documents and Settings\ekrengel\Desktop\Scripts\VBS LDIFDE AD EXPORT MEMBERS-DISTIBUTION\Users.xls"), 43
            objExcel.Quit
        
        WScript.Quit
        Sorry for not giving all the pieces...

        Comment


        • #5
          Re: modify vbs

          There are actualy two options for, when to cleanup/modify the text.
          You can perform cleanups over the complete content of the .ldf file in the un-splitted array (so don't split it yet while reading).
          Alternatively you can perform the cleanups after the splitting(s) during a For...Next loop (like in the previous example) just before writing to the outputfile.
          ~Note:
          When you want to write separate values to cells in a worksheet, and not each whole line per cell, you must, for each line, break the array again at comma into values (the values are comma separated in the text file).

          This is an example of the first option:
          Code:
          ' Dump the FILE content into an array
          Set objInputFile = objFileSystem.OpenTextFile(strOutputFile, ForReading)
          inputData = objInputFile.ReadAll
          objInputFile.Close
          
          'Cleanups **
            inputData = Replace(inputData, "\,", ",")
            inputData = Replace(inputData, "CN=", "")
            inputData = Replace(inputData, ", ", ",")
          MsgBox(inputData)
          
          'Now break the string into array at line breaks
          inputData = Split(inputData, vbNewline)
          btw,
          instead of using ldifde commandline, and reading its outpufile, you could also do it all within the script:

          'use the LDAP provider to return a domain group's members
          strDomainGrp = "CN=group,OU=ou, DC=domain,DC=domain,DC=com"
          Set objGroup = GetObject("LDAP://" & strDomainGrp)
          objGroup.GetInfo
          inputData = objGroup.GetEx("member")



          \Rems
          Last edited by Rems; 14th June 2007, 01:06.

          This posting is provided "AS IS" with no warranties, and confers no rights.

          __________________

          ** Remember to give credit where credit's due **
          and leave Reputation Points for meaningful posts

          Comment


          • #6
            Re: modify vbs

            btw,
            instead of using ldifde commandline, and reading its outpufile, you could also do it all within the script:

            'use the LDAP provider to return a domain group's members
            strDomainGrp = "CN=group,OU=ou, DC=domain,DC=domain,DC=com"
            Set objGroup = GetObject("LDAP://" & strDomainGrp)
            objGroup.GetInfo
            inputData = objGroup.GetEx("member")
            Ok.. using the script above, give only the Usernames. It does not output the First - and Lastnames of the users. And these values are probably what you want to showup in the excel file.

            - - - - -
            For the output to Excel -> If you only want to write the First- and Lastname to excel, then this can also be an option:
            Code:
            '(http://forums.petri.com/showthread.php?t=16367)
            
            sMembersOf = "Group-A"
            strContainer = "OU=ou-A,DC=domain,DC=domain,DC=com"
            strWorkFile = "groups.ldf"  '<-- If it is not in the same folder as the script then provide the complete path
            strOutputFile = "Output.xls" '<-- If it is not in the same folder as the script then provide the complete path 
            
            Set objShell = CreateObject("Wscript.Shell")
             strObject = chr(34)& "CN=" & sMembersOf &","& strContainer &chr(34)&" -l ""member"""
             strCommandLine = "ldifde.exe -f "& chr(34)& strWorkFile &chr(34) &" -s %LOGONSERVER% -d " & strObject
            'objShell.Run("%comspec% /c "& strCommandLine), 0, True
            Set objShell = Nothing
            
            Const ForReading   = 1
            
            Const xlAscending  = 1
            Const xlYes        = 1
            
            Set objFileSystem = CreateObject("Scripting.fileSystemObject")
             If Not InStr(strWorkFile, "\") Then strWorkFile = _
                 objFileSystem.GetParentFolderName(Wscript.ScriptFullName) _
                 &"\"&strWorkFile
             If Not InStr(strOutputFile, "\") Then strOutputFile = _
                 objFileSystem.GetParentFolderName(Wscript.ScriptFullName) _
                 &"\"&strOutputFile
            
            'Open a workbook for creation of a new XLS output file
            Set objExcel = CreateObject("Excel.Application")
            objExcel.Visible = False
            objExcel.Workbooks.Add
            'Initialize variables, and header/titles here for the workbook
            objExcel.Cells(1,1).Value = "Show all Members from the selected Group: " & sMembersOf
            objExcel.Cells(1,1).Font.Bold = True
            objExcel.Cells(1,1).Font.Size = 13
            objExcel.Cells(2,1).Value = "Time: " & Now
            objExcel.Cells(2,1).Font.Bold = True
             x = 4   '<-- starting to write the data from this row on in the worksheet!!
             y = 2   '<-- starting to write the data from this column in the worksheet!!
            
            
            ' Read the workFILE line-by-line in a Loop
            ' (this process will automatically Breaking the content into array at line breaks)
            'http://www.microsoft.com/technet/scr....mspx?mfr=true
            Set objStream = objFileSystem.OpenTextFile(strWorkFile, ForReading)
            
            On Error Resume Next '(!)
            
            Do While Not objStream.AtEndOfStream
            
               'read new line and breaking it into array at commas
               arrParams = Split(objStream.ReadLine, ",")
            
                   strLastname = ""
                   strLastname = arrParams(0)  '<-- 0 =Read the first Param from the line
                   strLastname = Trim(Replace(Mid(strLastname,4,Len(strLastname)),"\",""))
            
                   strFirstname = ""
                   strFirstname = Trim(arrParams(1))  '<-- 1 =Read the second Param from the line
            
                'output the first and second Param of each new line to cells in excel
                  y1 = y '(re-setting the column number for processing each *new* line content)
                  Y2 = 0
                  y3 = 0 ' (Upto the amount of columns that is needed, the value for must reset to Zero)
                   'ect.     ' because this script is ONLY going to write two values of each line to the outputfile,
                             ' we do not create an extra FOR..NEXT for each Param, we pick the value. But if we do
                             ' so, we must count-up the amount columns that is needed, statically   
            
                  objExcel.Cells(x,y1).Value = strLastname
                  y2 = y1 + 1
                  objExcel.Cells(x,y2).Value = strFirstname
            
            x = x + 1 'go to the next Row
            Loop
            objInputFile.Close
            
            
            'AutoFIt data columns, Force save and close spreadsheet.
            objExcel.Columns("B:BH").EntireColumn.AutoFit
            objExcel.DisplayAlerts = False
            Set objWorkbook = objExcel.ActiveWorkbook
            objWorkbook.SaveAs strOutputFile
            objWorkbook.Close
            objExcel.Quit
            
            wscript.echo "Done"
            wscript.Quit(0)
            Here in this example for the cleanup of CN=Firstname and spaceLastname, the Functions;
            - Trim(name)
            - Replace(name, "\", "")
            - Mid(name, 4, Len(name))
            are used for each value just before writing it to the cells.

            EDIT - Or,
            you can even leave the Replace() function out of this, if you write the line like this way:
            strLastname = Mid(strLastname,4,Len(strLastname)-4)

            \Rems
            Last edited by Rems; 15th June 2007, 09:51. Reason: Trim(Mid(strLastname,4,Len(strLastname)-4))

            This posting is provided "AS IS" with no warranties, and confers no rights.

            __________________

            ** Remember to give credit where credit's due **
            and leave Reputation Points for meaningful posts

            Comment


            • #7
              Re: modify vbs

              Wow thank you Rems for all the information and help. I think this should be enough for me to play around with and figure out what I like best. If I find any other information or a way to improve the script I will post it. Thanks.

              Comment


              • #8
                Re: modify vbs

                Your welcome mate.

                I was just playing with the code. I was looking for a way to avoid a For..Next within a For..Next loop.
                Now, not even onces a For...Next is used.

                This posting is provided "AS IS" with no warranties, and confers no rights.

                __________________

                ** Remember to give credit where credit's due **
                and leave Reputation Points for meaningful posts

                Comment


                • #9
                  Re: modify vbs

                  I just found this way to search for the right group...it's pretty cool:

                  Code:
                  Set WshShell = WScript.CreateObject("WScript.Shell")
                  Set objNet = CreateObject("WScript.Network")
                  Set objRootDSE = GetObject("LDAP://rootDSE")
                  strADsConfPath = "LDAP://" & objRootDSE.Get("configurationNamingContext")
                  strRootDSE = objRootDSE.Get("defaultNamingContext")
                  strDomain = UCase(objNet.UserDomain)
                  strSearch = LCase(InputBox("Select the group you would like to use:"))
                  ListGroups( strDomain )
                  intOpt = 1
                  sGroup = SelectBox("Select the Group", aOpt)
                  
                  Sub ListGroups( strDomain )
                  Set objComputer = GetObject("WinNT://" & strDomain )
                  objComputer.Filter = Array( "Group" )
                  For Each objGroup In objComputer
                  if InStr(LCase(objGroup.Name),strSearch) then
                  ReDim Preserve aOpt(intOpt+ 1)
                  aOpt(intOpt) = objGroup.Name
                  intOpt = intOpt + 1
                  end if
                  Next
                  End Sub
                  
                  Function SelectBox(sTitle, aOptions)
                  Dim oIE, s, item
                  set oIE = CreateObject("InternetExplorer.Application")
                  With oIE
                  .FullScreen = True
                  .ToolBar = False : .RegisterAsDropTarget = False
                  .StatusBar = False : .Navigate("about:blank")
                  Do Until .ReadyState = 4 : WScript.Sleep 100 : Loop
                  .width= 400 : .height=200
                  With .document
                  with .parentWindow.screen
                  oIE.left = (.availWidth - oIE.width ) \ 2
                  oIE.top = (.availheight - oIE.height) \ 2
                  End With
                  s = "<html><head><title>" & sTitle _
                  & "</title></head><script language=vbs>bWait=true<" & "/script>" _
                  & "<body bgColor=Silver><center>" _
                      & "<b>" & sTitle & "<b><p>" _
                  & "<select id=entries size=1 style='width:325px'>" _
                  & " <option selected>" & sTitle & "</option>"
                  For each item in aOptions
                  s = s & " <option>" & item & "</option>"
                  Next
                  s = s & " </select><p>" _
                  & "<button id=but0 onclick='bWait=false'>OK</button>" _
                  & "</center></body></html>"
                  .open
                  .Write(s)
                  .close
                  Do until .ReadyState ="complete" : Wscript.Sleep 50 : Loop
                  With .body
                  .scroll="no"
                  .style.borderStyle = "outset"
                  .style.borderWidth = "3px"
                  End With
                  .all.entries.focus
                  oIE.Visible = True
                  CreateObject("Wscript.Shell").AppActivate sTitle
                  On Error Resume Next
                  Do While .ParentWindow.bWait
                  WScript.Sleep 100
                  if oIE.Visible Then SelectBox = "Aborted"
                  if Err.Number <> 0 Then Exit Function
                  Loop
                  On Error Goto 0
                  With .ParentWindow.entries
                  SelectBox = .options(.selectedIndex).text
                  End With
                  End With
                  .Visible = False
                  End With
                  End Function

                  Comment


                  • #10
                    Re: modify vbs

                    Rems,

                    This is part of the script that I just found...do you know how to fix this so it uses "objExcel" instead of reading from the registry to open excel? I don't really understand the way it's using the registry for this...it prevents me from formatting the excel file untill its saved and closed manually when the script is done. Is there a way to close and save the file with this method?



                    Code:
                    Set oGroup = GetObject("WinNT://" & strDomain & "/" & sGroup & ",group")
                    if sgroup <> "Aborted" then
                    if sgroup <> "Select the Group" then
                    if strFormat = "Excel" then
                    strFile = sgroup & ".xls"
                    Set fso = CreateObject("Scripting.FileSystemObject")
                    If fso.FileExists(strFile) Then
                    fso.DeleteFile(strFile)
                    End If
                    Set txtFile = fso.CreateTextFile(strFile)
                    i = 0
                    For Each oUser In oGroup.Members
                    i = i + 1
                    strGetUserName=""
                    strDN=""
                    strMail=""
                    strGetUserName= UCase(oUser.Name)
                    while strDN=""
                    CheckForUser()
                    Wend
                    GetUserAccount(strDN)
                    txtFile.write (oUser.Name & " ; " & strDisplayDepartment & " ; " & strMail & vbCrLf)
                    Next
                    txtfile.close
                    Set txtfile = nothing
                    Set fso = nothing
                    strKey = "HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\Excel.exe\path"
                    If KeyExists(strKey) = True Then
                    strKeyValue = WshShell.RegRead(strKey)
                    rval = WshShell.Run(chr(34) & strKeyValue & "excel.exe" & chr(34) & " " & chr(34) & strFile & chr(34) ,1,True)
                    else
                    rval = WshShell.Run("notepad.exe" & " " & strFile,1,True)
                    end if
                    else
                    For Each oUser In oGroup.Members
                    i = i + 1
                    strGetUserName=""
                    strDN=""
                    strMail=""
                    strGetUserName= UCase(oUser.Name)
                    while strDN=""
                    CheckForUser()
                    Wend
                    GetUserAccount(strDN)
                    strBCC = strBCC & strMail &"; "
                    Next
                    Set oMailApp = CreateObject("Outlook.Application")
                    Set olMailItm = oMailApp.CreateItem(olMailItem)
                    olMailItm.BCC = strBCC
                    olMailItm.Display
                    end if
                    end if
                    end if
                    
                    Function KeyExists(sKeyPath)
                    keyExists= false: if (sKeyPath="") then exit function
                    on error resume next
                    createobject("wscript.shell").regRead sKeyPath
                    select case err
                    case 0: keyExists= true
                    case &h80070002: dim sErrMsg
                    sErrMsg= replace(err.description, sKeyPath, "")
                    err.clear
                    createobject("wscript.shell").regRead "HKEY_ERROR\"
                    keyExists= not (sErrMsg=replace(err.description, "HKEY_ERROR\", ""))
                    case else: keyExists= false
                    end select
                    on error goto 0
                    End function

                    Comment


                    • #11
                      Re: modify vbs

                      Find the loop:

                      Code:
                      For Each oUser In oGroup.Members
                         strGetUserName=""
                         strDN=""
                         strMail=""
                         strGetUserName= UCase(oUser.Name)
                          While strDN=""
                             CheckForUser()
                          Wend
                         GetUserAccount(strDN)
                      '\
                       txtFile.write (oUser.Name & " ; " & strDisplayDepartment & " ; " & strMail & vbCrLf)
                      '/
                      Next

                      You can see that each line is append to a csv-file here (btw, in a non-EnglishFormat where comma is changed to semicolon)
                      After the "Next" this cvs-file is closed (txtFile.close). Now the file is ready for reading.

                      This script checks (using the registry) if Excel is installed on this computer.
                      If it is installed: it uses the path (found in the registry) to execute excel.exe.
                      If not installed: It uses Notepad.exe instead - to open the csv-file.

                      The script is a bit strange, it check IF excel is installead but it assumes that Outlook IS installed.


                      For writing directly to an excel workbook (see my previous example):
                      You have to SET objExcel = CreateObject("Excel.Application")
                      and Initialize it before this For...Next loop
                      Don't for get the lines to set the starting points in the workbook:
                      x = 4 '<-- starting to write the data from this row on in the worksheet!!
                      y = 2 '<-- starting to write the data from this column in the worksheet!!
                      These new lines replacing the lines:
                      Set fso = CreateObject("Scripting.FileSystemObject")
                      If fso.FileExists(strFile) Then
                      fso.DeleteFile(strFile)
                      End If
                      Set txtFile = fso.CreateTextFile(strFile)
                      i = 0




                      Now in the For..Next loop, the script must going to write the three values to cells in the workbook (see alsomy previous example:

                      Code:
                      
                            y1 = y '(re-setting the column number for processing each *new* line content)
                            objExcel.Cells(x,y1).Value = oUser.Name
                            y1 = y1 + 1
                            objExcel.Cells(x,y1).Value = strDisplayDepartment
                            y1 = y1 + 1
                            objExcel.Cells(x,y1).Value =  strMail
                            x = x + 1 'go to the next Row
                      In you script this code comes instead of the line:
                      txtFile.write (oUser.Name & " ; " & strDisplayDepartment & " ; " & strMail & vbCrLf)
                      Before "Next".


                      Cleanup:
                      After the loop, replace the lines:
                      Code:
                      strKey = "HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\Excel.exe\path"
                      If KeyExists(strKey) = True Then
                      strKeyValue = WshShell.RegRead(strKey)
                      rval = WshShell.Run(chr(34) & strKeyValue & "excel.exe" & chr(34) & " " & chr(34) & strFile & chr(34) ,1,True)
                      else
                      rval = WshShell.Run("notepad.exe" & " " & strFile,1,True)
                      end if
                      With:
                      Code:
                      'AutoFIt data columns, Force save and close spreadsheet.
                      objExcel.Columns("B:BH").EntireColumn.AutoFit
                      objExcel.DisplayAlerts = False
                      Set objWorkbook = objExcel.ActiveWorkbook
                      objWorkbook.SaveAs strFile
                      objWorkbook.Close
                      objExcel.Quit
                      Now you can delete the function: Function KeyExists(sKeyPath) ... End Function


                      (did not test it)

                      \Rems

                      This posting is provided "AS IS" with no warranties, and confers no rights.

                      __________________

                      ** Remember to give credit where credit's due **
                      and leave Reputation Points for meaningful posts

                      Comment


                      • #12
                        Re: modify vbs

                        I gave it a try...and it's give me a runtime error...line 53 charater 7....

                        Code:
                        Dim objGroup, objUser, objShell, WshShell, strMessage, strDomain, strUserMail, strRootDSE, strGetUserName, oUser, fso, objExcel
                        Dim objNet, major, minor, ver, strMail, strLogonName, strValue, strDisplayDescription, strDisplayDepartment, strDN
                        Dim strSearch, strMostRecentIP, aOpt(), intOpt, oGroup, sGroup, txtFile, objComputer
                        Dim objRootDSE, strTemp, strADsConfPath, strFormat, strFile, i, objConnection, objCommand, objRecordSet, objectRecordSet
                        Dim strKey, strKeyValue, rval, strBCC, oMailApp, olMailItm, olMailItem, intSize, strDelegateCount, strFullName
                        
                        Set WshShell = WScript.CreateObject("WScript.Shell")
                        Set objShell = CreateObject("Wscript.Shell")
                        Set objNet = CreateObject("WScript.Network")
                        Set objRootDSE = GetObject("LDAP://rootDSE")
                        strADsConfPath = "LDAP://" & objRootDSE.Get("configurationNamingContext")
                        strRootDSE = objRootDSE.Get("defaultNamingContext")
                        strDomain = UCase(objNet.UserDomain)
                        strSearch = LCase(InputBox("Select the group you would like to use."))
                        ListGroups( strDomain )
                        intOpt = 1
                        sGroup = SelectBox("Select the Group", aOpt)
                        strFormat = "Excel"
                        
                        Set oGroup = GetObject("WinNT://" & strDomain & "/" & sGroup & ",group")
                        if sgroup <> "Aborted" then
                        if sgroup <> "Select the Group" then
                        if strFormat = "Excel" then
                        strFile = "temp.csv"
                        Set objExcel = CreateObject("Excel.Application")
                        x = 4
                        y = 2
                        
                        For Each oUser In oGroup.Members
                        i = i + 1
                        strGetUserName=""
                        strDN=""
                        strMail=""
                        strGetUserName= UCase(oUser.Name)
                        while strDN=""
                        CheckForUser()
                        Wend
                        GetUserAccount(strDN)
                        
                        y1 = y '(re-setting the column number for processing each *new* line content)
                              objExcel.Cells(x,y1).Value = strLogonName
                              y1 = y1 + 1
                              objExcel.Cells(x,y1).Value = strDisplayDepartment
                              y1 = y1 + 1
                              objExcel.Cells(x,y1).Value =  strMail
                              x = x + 1 'go to the next Row
                        
                        Next
                        
                        'AutoFIt data columns, Force save and close spreadsheet.
                        objExcel.Columns("B:BH").EntireColumn.AutoFit
                        objExcel.DisplayAlerts = False
                        Set objWorkbook = objExcel.ActiveWorkbook
                        objWorkbook.SaveAs strFile
                        objWorkbook.Close
                        objExcel.Quit
                        else
                        
                        For Each oUser In oGroup.Members
                        i = i + 1
                        strGetUserName=""
                        strDN=""
                        strMail=""
                        strGetUserName= UCase(oUser.Name)
                        while strDN=""
                        CheckForUser()
                        Wend
                        GetUserAccount(strDN)
                        strBCC = strBCC & strMail &"; "
                        Next
                        Set oMailApp = CreateObject("Outlook.Application")
                        Set olMailItm = oMailApp.CreateItem(olMailItem)
                        olMailItm.BCC = strBCC
                        olMailItm.Display
                        end if
                        end if
                        end if
                        
                        Sub CheckForUser()
                        Set objConnection = CreateObject("ADODB.Connection")
                        objConnection.Provider = ("ADsDSOObject")
                        objConnection.Open
                        Set objCommand = CreateObject("ADODB.Command")
                        objCommand.ActiveConnection = objConnection
                        objCommand.CommandText = _
                        "<LDAP://" & strRootDSE & ">;(&(objectCategory=User)" & _
                        "(samAccountName=" & strGetUserName & "));distinguishedName,cn,sAMAccountName,name;subtree"
                        Set objRecordSet = objCommand.Execute
                        strDN = objRecordset.Fields("distinguishedName")
                        Set objectRecordSet = Nothing
                        objConnection.close
                        Set objConnection = Nothing
                        
                        End Sub
                        
                        Sub GetUserAccount(strDN)
                        On Error Resume Next
                        If InStr(1,strDN,"/") Then strDN=Replace(strDN,"/","\/")
                        Set objUser = GetObject("LDAP://" & strDN & "")
                        Set objAdS = GetObject("LDAP://" & strRootDSE & "")
                        
                        With objUser
                        '.GetInfo
                        strMail = .Get("mail")
                        strLogonName = .Get("cn")
                        strUserMail = .Get("mail")
                        strDescription = .GetEx("description")
                        strDepartment = .GetEx("department")
                        
                        strDisplayDepartment=""
                        For Each strValue in strDepartment
                        strDisplayDepartment = strDisplayDepartment & strValue
                        Next
                        
                        For Each strValue in strDescription
                        strDisplayDescription = strDisplayDescription & strValue
                        Next
                        
                        End With
                        
                        End Sub
                        
                        Sub ListGroups( strDomain )
                        Set objComputer = GetObject("WinNT://" & strDomain )
                        objComputer.Filter = Array( "Group" )
                        For Each objGroup In objComputer
                        if InStr(LCase(objGroup.Name),strSearch) then
                        ReDim Preserve aOpt(intOpt+ 1)
                        aOpt(intOpt) = objGroup.Name
                        intOpt = intOpt + 1
                        end if
                        Next
                        End Sub
                        
                        Function SelectBox(sTitle, aOptions)
                        Dim oIE, s, item
                        set oIE = CreateObject("InternetExplorer.Application")
                        With oIE
                        .FullScreen = True
                        .ToolBar = False : .RegisterAsDropTarget = False
                        .StatusBar = False : .Navigate("about:blank")
                        Do Until .ReadyState = 4 : WScript.Sleep 100 : Loop
                        .width= 400 : .height=200
                        With .document
                        with .parentWindow.screen
                        oIE.left = (.availWidth - oIE.width ) \ 2
                        oIE.top = (.availheight - oIE.height) \ 2
                        End With
                        s = "<html><head><title>" & sTitle _
                        & "</title></head><script language=vbs>bWait=true<" & "/script>" _
                        & "<body bgColor=Silver><center>" _
                            & "<b>" & sTitle & "<b><p>" _
                        & "<select id=entries size=1 style='width:325px'>" _
                        & " <option selected>" & sTitle & "</option>"
                        For each item in aOptions
                        s = s & " <option>" & item & "</option>"
                        Next
                        s = s & " </select><p>" _
                        & "<button id=but0 onclick='bWait=false'>OK</button>" _
                        & "</center></body></html>"
                        .open
                        .Write(s)
                        .close
                        Do until .ReadyState ="complete" : Wscript.Sleep 50 : Loop
                        With .body
                        .scroll="no"
                        .style.borderStyle = "outset"
                        .style.borderWidth = "3px"
                        End With
                        .all.entries.focus
                        oIE.Visible = True
                        CreateObject("Wscript.Shell").AppActivate sTitle
                        On Error Resume Next
                        Do While .ParentWindow.bWait
                        WScript.Sleep 100
                        if oIE.Visible Then SelectBox = "Aborted"
                        if Err.Number <> 0 Then Exit Function
                        Loop
                        On Error Goto 0
                        With .ParentWindow.entries
                        SelectBox = .options(.selectedIndex).text
                        End With
                        End With
                        .Visible = False
                        End With
                        End Function
                        
                        WScript.Quit

                        Comment


                        • #13
                          Re: modify vbs

                          Originally posted by ["my self"]
                          You have to SET objExcel = CreateObject("Excel.Application")
                          and Initialize it before this For...Next loop
                          Don't forget the lines to set the starting points in the workbook:
                          x = 4 '<-- starting to write the data from this row on in the worksheet!!
                          y = 2 '<-- starting to write the data from this column in the worksheet!!
                          Code:
                          Set objExcel = CreateObject("Excel.Application")
                          objExcel.Visible = False
                          objExcel.Workbooks.Add
                          objExcel.Cells(1,1).Value = "Show all Members from the selected Group: " & sGroup
                          objExcel.Cells(1,1).Font.Bold = True
                          objExcel.Cells(1,1).Font.Size = 13
                          objExcel.Cells(2,1).Value = "Time: " & Now
                          objExcel.Cells(2,1).Font.Bold = True
                           x = 4   '<-- starting to write the data from this row on in the worksheet!!
                           y = 2   '<-- starting to write the data from this column in the worksheet!!


                          \Rems

                          EDIT -
                          btw - the output filename must have the extension XLS now (not csv anymore).
                          strFile = "C:\temp.XLS"
                          Last edited by Rems; 20th June 2007, 17:27.

                          This posting is provided "AS IS" with no warranties, and confers no rights.

                          __________________

                          ** Remember to give credit where credit's due **
                          and leave Reputation Points for meaningful posts

                          Comment


                          • #14
                            Re: modify vbs

                            Thanks....no error that time...but nothing happened. I didn't see the excel file anywhere...

                            *Nevermind...I got it. I had to specify the path with strFile. Thanks again Rems.
                            Last edited by ekrengel; 20th June 2007, 17:34.

                            Comment


                            • #15
                              Re: modify vbs

                              *Nevermind...I got it. I had to specify the path with strFile.
                              If you don't specify a path, the strFile wil be written to your 'My Documents' folder.
                              It is possible that after the error of your previous script, Excel was not functioning very well. In that case check the processes if all instances of Excel.exe are ended, (I had to to stop the process manualy).

                              I runned your script with Vbsedit 3.3 it stated there was a problem processing all the lines: objExcel.Cells(x,y1).Value = That gave me a clue the line objExcel.Workbooks.Add was missing.

                              Vbsedit is a better script editor than the default 'Notepad.exe' is. But it is not freeware. Although the evaluation version never expires, this version will always give messages and delay times. That is why I prefere Notepad2.exe (freeware) as the default script editor. You can save Notepad2.exe in the system32 folder. Then, using 'Folder Options'/ 'File Types' you can change the default editor for vbs-files to notepad2.exe, if you like.

                              \Rems

                              This posting is provided "AS IS" with no warranties, and confers no rights.

                              __________________

                              ** Remember to give credit where credit's due **
                              and leave Reputation Points for meaningful posts

                              Comment

                              Working...
                              X