Solved

Create an Excel hyperlink to "Place in this Document"

Posted on 2008-10-13
6
993 Views
Last Modified: 2013-12-24
I routinely get asked to export the membership of all the group in our 2003 domain to an Excel sheet with a tab for each group and the members in that tab.  I have no problem doing this except that our domain has over 500 groups.  To make their lives easier, I've been asked to create an index page with links to the various tabs within the workbook.  This is where I am coming up short.  I understand how to create links, but the code I've attached does not work (i.e. there is no link actually created).  I'm not sure if this is because the code I've developed doesn't first save the Excel workbook, but I'd rather avoid saving the workbook and leaving it up to the user whether or not to save it.
'create excel application object and associated workbook, worksheets reference
Set objExcel = CreateObject("Excel.Application")
Set objBook = objExcel.Workbooks.Add
Set objSheets = objBook.Sheets
objExcel.Visible = True
objExcel.DisplayAlerts = False
 
'remove all but the very first sheet
i = objSheets.Count
Do Until i = 1 
  objSheets(i).Delete
  i = i - 1
Loop
 
'create a generic connection to Active Directory
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
 
'query Active Directory for all groups and sort by common name
objCommand.Properties("Sort On")  = "cn"
strDomain = GetObject("LDAP://rootDSE").Get("defaultNamingContext")
objCommand.CommandText = "<LDAP://" & strDomain & ">;(objectCategory=group);ADsPath,cn;subtree"
objCommand.Properties("Page Size")=1000
Set objRecordSet = objCommand.Execute
 
'iterate thru all groups
While Not objRecordSet.EOF
	On Error Resume Next
	intRow = 1
 
'create a reference to the group
	Set objGroup = GetObject(objRecordset.Fields("ADsPath"))
 
'rename the sheet the common name of the group
	objSheets(objSheets.Count).Name = cleanName(objGroup.cn)
 
'create a reference to the current sheet
	Set objSheet = objSheets(objSheets.Count)
 
'iterate thru all users of the Member attribute of the group
	For Each strUser in objGroup.Member
 
'create a reference to the user object defined identified in the Member attribute
    		Set objUser =  GetObject("LDAP://" & strUser)
 
'Take the common name of the user object and update the current Excel sheet cell with the value
		objSheet.Cells(intRow, 1) = objUser.cn
 
'intRow controls what cell is currently being written to in the inner loop
		intRow = intRow + 1
	Next
 
'Reset the inner loop control variable for writing to Excel
	intRow = 1
 
'Add the a sheet for the next group or the last sheet in the case of the index
	objSheets.Add ,objSheet,1
	objRecordSet.MoveNext
Wend
 
objConnection.Close
 
'control variable to iterate thru all the sheets in the workbook
i = 1
 
'reference the index sheet
Set objSheet = objSheets(objSheets.Count)
 
'iterate thru all the sheets
Do Until i = objSheets.Count
'set the cells in the index sheet equal to a hyperlink to every other sheet in the workbook	
         objSheet.Cells(i, 1) = objSheets(i).Name
	Set objRange = objSheet.Range("A" & i)
 
'THIS DOES NOT CREATE THE HYPERLIKE LIKE IT SHOULD
	Set objLink = objSheet.Hyperlinks.Add(objRange, objSheets(i).Name & "!" & "A" & i,,,objSheets(i).Name)
	i = i + 1
Loop
 
'function to check Excel sheet name to conform with syntax requirements
Function cleanName (ByVal strName)
	strTemp = Replace(strName, "\", "-")
	strTemp = Replace(strTemp, "/", "-")
	strTemp = Replace(strTemp, "?", "-")
	strTemp = Replace(strTemp, "*", "-")
	strTemp = Replace(strTemp, "[", "-")
	strTemp = Replace(strTemp, "]", "-")
	strTemp = Replace(strTemp, ":", "-")
	If Len(strTemp) > 30 Then
		strTemp = Mid(strTemp, 1, 27) & "..."
	End If
	cleanName = strTemp
End Function

Open in new window

0
Comment
Question by:ccovell
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
6 Comments
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 22704432
Try this:

Set objLink = objSheet.Hyperlinks.Add(Anchor:=objRange, Address:=ThisWorkbook.FullName, SubAddress:="'" & objSheets(i).Name & "'!" & "A" & i,ScreenTip:=objSheets(i).Name)

Kevin
0
 

Author Comment

by:ccovell
ID: 22705050
Greetings Kevin,
Actually, that's what I started out trying first.  However, this is a VB script and VBA code like this just does not seem to work in a command line script like this.  I have a feeling it is not working because there is not reference to the workbook in the URL in the code I posted.  If you look at the properties of a file spawned by a VBS CreateObject("Excel.Application"), it has not path listed.  I imagine because the file just exists in memory and is not saved yet.  Is there a Path attribute to the ThisWorkbook object?

Thanks
Clayton
0
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 22705113
Try this:

Set objLink = objSheet.Hyperlinks.Add(Anchor:=objRange, Address:=objSheet.Parent.FullName, SubAddress:="'" & objSheets(i).Name & "'!" & "A" & i,ScreenTip:=objSheets(i).Name)

Kevin
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:ccovell
ID: 22705185
Unfortunately, still no luck.  Trying to run a script like this from the command line with := assignment causes a compilation error.  What I have noticed is that when you attempt to echo the ThisWorkbook.FullName, the value returned is "Book1" (default name for new, unsaved workbook).  However, when I echo out the ThisWorkbook.Path, nothing (i.e. Null) is returned.  This is probably why the Path attribute is set to "unknown" when you look at the File->Properties of the workbook created by this script.  It almost seems as though I have to save the file first.
0
 
LVL 81

Accepted Solution

by:
zorvek (Kevin Jones) earned 250 total points
ID: 22705233
Without named parameters:

Set objLink = objSheet.Hyperlinks.Add(objRange, objSheet.Parent.FullName, "'" & objSheets(i).Name & "'!" & "A" & i, , objSheets(i).Name)

Kevin
0
 

Author Closing Comment

by:ccovell
ID: 31407094
Prompt and professional answer.  Thanks Kevin.
0

Featured Post

[Webinar] Code, Load, and Grow

Managing multiple websites, servers, applications, and security on a daily basis? Join us for a webinar on May 25th to learn how to simplify administration and management of virtual hosts for IT admins, create a secure environment, and deploy code more effectively and frequently.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Never store passwords in plain text or just their hash: it seems a no-brainier, but there are still plenty of people doing that. I present the why and how on this subject, offering my own real life solution that you can implement right away, bringin…
These days, all we hear about hacktivists took down so and so websites and retrieved thousands of user’s data. One of the techniques to get unauthorized access to database is by performing SQL injection. This article is quite lengthy which gives bas…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

732 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question