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!

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

Excel - Naming Worksheets

Status
Not open for further replies.

Meldric

MIS
Sep 5, 2001
139
US
I am having a problem with a new script I am writing(I have tabled the active directory script for the moment). It will eventually list all the groups in our exchange schema and all users per group in a excel spreadsheet. Right now when I run the script all I want is each sheet in the workbook to be named after the group it represents. The result I get from the following script is that it changes the name of the first sheet and creates all the other sheets, but does not rename them. Any ideas what is wrong with my script?
Code:
Dim g_iCounter, g_oSheet, g_oExcel, oGroupObj

call Main()

Function Main()
   
   g_iCounter = 0
   
   Set g_oExcel = CreateObject("Excel.Application")
   
   g_oExcel.Workbooks.Add
   
   set oGroupObj = GetObject("LDAP://OU=GROUPS,OU=TEST,DC=TESTSVR,DC=COM")
 
   for each oGroup in oGroupObj
   
      g_iCounter=g_iCounter + 1

      g_oExcel.ActiveWorkbook.Worksheets.Add

      Set g_oSheet = g_oExcel.ActiveWorkbook.Worksheet (g_iCounter)

      g_oSheet.Cells(1,1).Font.Size = 12
      g_oSheet.Cells(1,1).Font.Bold = True
      g_oSheet.Range("A1:H1").Interior.Color = RGB(100,100,100)
      g_oSheet.Cells(1,1).Value = "Group Name:  " & oGroup.Name
 
      g_oSheet.Name = oGroup.Name
   next

   g_oExcel.ActiveWorkbook.SaveAs "c:\all email groups dump.xls"
   g_oExcel.ActiveWorkbook.Close
End Function

Thank you everyone in advance for the help.

Roger
 
Hello, Meldric.

The little surgery you have to make is to isolate the creation of sufficient number of worksheets to accomodate all the groups from the editing the worksheets. This is the main amendment which is to correct the misbehavior of the script.

A minor issue is the template you use to add a workbook. By default, it may create one, two, three ... worksheets depending on the definition of your default template. This leads to a total number of worksheets more than the groups you have. This is a minor annoyance. The major annoyance is that when Excel adds a worksheet, its position is not at the end (appending), but is inserting. Hence, if you edit the contents immediately after adding worksheets, your ordering is disturbed and become really annoying. Again, the isolation mentioned above cures this problem as a by-product.

Combining what said, and assuming your script has taken care of the proper use of object model, below is a revision script I propose.
Only one variable (int_templatesheet) is added for the convenience of scripting.

I usually use slightly different objects than yours, so when some lines go wrong just post back so that I can amend them.

regards - tsuji

'-----------------------------
Dim g_iCounter, g_oSheet, g_oExcel, oGroupObj, int_templatesheet

call Main()

Function Main()

Set g_oExcel = CreateObject("Excel.Application")
g_oExcel.Workbooks.Add
int_templatesheet = g_oExcel.WorkSheets.Count
Set oGroupObj = GetObject("LDAP://OU=GROUPS,OU=TEST,DC=TESTSVR,DC=COM")
g_iCounter = 0
For Each oGroup In oGroupObj
g_iCounter=g_iCounter + 1
If g_iCounter > int_templatesheet Then
g_oExcel.ActiveWorkbook.Worksheets.Add
End If

Next
g_iCounter = 0
For Each oGroup In oGroupObj
g_iCounter=g_iCounter + 1
Set g_oSheet = g_oExcel.ActiveWorkbook.Worksheet(g_iCounter)
g_oSheet.Cells(1,1).Font.Size = 12
g_oSheet.Cells(1,1).Font.Bold = True
g_oSheet.Range("A1:H1").Interior.Color = RGB(100,100,100)
g_oSheet.Cells(1,1).Value = "Group Name: " & oGroup.Name
g_oSheet.Name = oGroup.Name '<<<Make sure no illegal characters
Next
g_oExcel.ActiveWorkbook.SaveAs &quot;c:\all email groups dump.xls&quot;
g_oExcel.ActiveWorkbook.Close

End Function
'-----------------------------
 
Thanks for the help. Seems to be working great now.

Roger
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top