Solved

Create an Excel hyperlink to "Place in this Document"

Posted on 2008-10-13
6
985 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
  • 3
  • 3
6 Comments
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
Comment Utility
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
Comment Utility
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)
Comment Utility
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
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:ccovell
Comment Utility
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
Comment Utility
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
Comment Utility
Prompt and professional answer.  Thanks Kevin.
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
Shadow IT is coming out of the shadows as more businesses are choosing cloud-based applications. It is now a multi-cloud world for most organizations. Simultaneously, most businesses have yet to consolidate with one cloud provider or define an offic…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

772 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

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now