Programatically Enable VBIDE Reference?

[RayportingMonkey]

First off, let me say that I never use my "power" for evil... Only for good!

Now, with that out of the way...

I have a script that creates a series of new workbooks and copies certain
data into them. I need to track who is using these reports, but they are
distributed on a SharePoint where statistics have not been enabled.

So, I have written a simple OnOpen script that appends a log with date,
time, ThisWorkook.Name and Application.UserName. Grant it, if the user does
not enable macros I don't get the data anyway, but this is a pilot and we
just need a good idea of who is using them.

Anyway, I have another routine that copies the necessary code into the
ThisWorkbook object, but in order for it to execute, I need to enable a
reference to "Microsoft Visual Basic For Applications Extensibility 5.3" on
the new workbook.

I can make everything else run automatically, but for each new workbook, it
seems I would have to manually set this reference, which defeats my purpose...

Is there a way to programatically enable a reference to "Microsoft Visual
Basic For Applications Extensibility 5.3"?

Is there a different/better method of setting up both a private sub and an
OnOpen event in a new workbook?

Any enlightenment would help me in this dark place!

Regards,
Ray

 

[RB Smissaert]

Here some general purpose code:

Sub AddReference(strGUID As String, _
Optional lMajor As Long, _
Optional lMinor As Long, _
Optional strWorkbook As String)

Dim oRef As Object
Dim oVBProj As Object

On Error Resume Next

If Len(strWorkbook) = 0 Then
strWorkbook = ThisWorkbook.Name
End If

Set oVBProj = Workbooks(strWorkbook).VBProject

Set oRef = oVBProj.References.AddFromGuid(GUID:=strGUID, _
Major:=lMajor, _
Minor:=lMinor)

End Sub


Sub test()

AddReference "{0002E157-0000-0000-C000-000000000046}"

End Sub


RBS

 

[RB Smissaert]

And I suppose you also may need some code to get all the details of all the
different references:

Sub ListExcelReferences()

Dim i As Long
Dim n As Long
Dim lRefCount As Long
Dim oVBProj As Object

Cells.Clear

Cells(1).Value = "Project name"
Cells(2).Value = "Project file"
Cells(3).Value = "Reference Name"
Cells(4).Value = "Description"
Cells(5).Value = "FullPath"
Cells(6).Value = "GUID"
Cells(7).Value = "Major"
Cells(8).Value = "Minor"

'as an un-saved workbook has no filename yet
On Error Resume Next

For Each oVBProj In Application.VBE.oVBProjects
n = n + 1
With oVBProj
lRefCount = .References.Count
With .References
For i = 1 To lRefCount
n = n + 1
If i = 1 Then
Cells(n, 1).Value = oVBProj.Name
Cells(n, 2).Value = oVBProj.Filename
If Err.Number = 76 Then 'Path not found
Cells(n, 2).Value = "Project not saved yet"
Err.Clear
End If
End If
Cells(n, 3).Value = .Item(i).Name
Cells(n, 4).Value = .Item(i).Description
Cells(n, 5).Value = .Item(i).FullPath
Cells(n, 6).Value = .Item(i).GUID
Cells(n, 7).Value = .Item(i).Major
Cells(n, 8).Value = .Item(i).Minor
Next i
End With
End With
Next oVBProj

Range(Cells(1), Cells(8)).Font.Bold = True
Range(Cells(1), Cells(n, 8)).Columns.AutoFit

End Sub


RBS

 

[RayportingMonkey]

I added that into another sub on the new workbook and called it before
executing the rest of the code and it worked like a charm!

I then opened a sampling of my newly created workbooks to simulate user
activity, went to my log file and low-and-behold I have useable data!

Thanks Chip!

 

[RB Smissaert]

Sorry, there was a simple typo bug:

It should be:
For Each oVBProj In Application.VBE.VBProjects

And not:
For Each oVBProj In Application.VBE.oVBProjects


RBS

Can't get this code to work?!?

It just returns an empty list, with only the headers???

And, I do have set some references

What am I doing wrong?!?

 

[RB Smissaert]

That would be something like this:

Sub ListWorkbookReferences()

Dim i As Long
Dim n As Long
Dim strWorkbook As String
Dim lRefCount As Long
Dim oVBProj As Object

'for an add-in do ThisWorkbook.Name
strWorkbook = ActiveWorkbook.Name

Set oVBProj = Workbooks(strWorkbook).VBProject

Cells.Clear

Cells(1).Value = "Project name"
Cells(2).Value = "Project file"
Cells(3).Value = "Reference Name"
Cells(4).Value = "Description"
Cells(5).Value = "FullPath"
Cells(6).Value = "GUID"
Cells(7).Value = "Major"
Cells(8).Value = "Minor"

'as an un-saved workbook has no filename yet
On Error Resume Next

n = 1

With oVBProj
lRefCount = .References.Count
With .References
For i = 1 To lRefCount
n = n + 1
If i = 1 Then
Cells(n, 1).Value = oVBProj.Name
Cells(n, 2).Value = oVBProj.Filename
If Err.Number = 76 Then 'Path not found
Cells(n, 2).Value = "Project not saved yet"
Err.Clear
End If
End If
Cells(n, 3).Value = .Item(i).Name
Cells(n, 4).Value = .Item(i).Description
Cells(n, 5).Value = .Item(i).FullPath
Cells(n, 6).Value = .Item(i).GUID
Cells(n, 7).Value = .Item(i).Major
Cells(n, 8).Value = .Item(i).Minor
Next i
End With
End With

Range(Cells(1), Cells(8)).Font.Bold = True
Range(Cells(1), Cells(n, 8)).Columns.AutoFit

End Sub


RBS

 

[Bob Phillips]

Sub ListExcelReferences()

Dim i As Long
Dim n As Long
Dim lRefCount As Long
Dim oVBProj As Object

Cells.Clear

Cells(1).Value = "Project name"
Cells(2).Value = "Project file"
Cells(3).Value = "Reference Name"
Cells(4).Value = "Description"
Cells(5).Value = "FullPath"
Cells(6).Value = "GUID"
Cells(7).Value = "Major"
Cells(8).Value = "Minor"

'as an un-saved workbook has no filename yet
On Error Resume Next

Set oVBProj = Application.VBE.ActiveVBProject
n = 1
With oVBProj
lRefCount = .References.Count
With .References
For i = 1 To lRefCount
n = n + 1
If i = 1 Then
Cells(n, 1).Value = oVBProj.Name
Cells(n, 2).Value = oVBProj.Filename
If Err.Number = 76 Then 'Path not found
Cells(n, 2).Value = "Project not saved yet"
Err.Clear
End If
End If
Cells(n, 3).Value = .Item(i).Name
Cells(n, 4).Value = .Item(i).Description
Cells(n, 5).Value = .Item(i).FullPath
Cells(n, 6).Value = .Item(i).GUID
Cells(n, 7).Value = .Item(i).Major
Cells(n, 8).Value = .Item(i).Minor
Next i
End With
End With

Range(Cells(1), Cells(8)).Font.Bold = True
Range(Cells(1), Cells(n, 8)).Columns.AutoFit

End Sub