I recently had to document the methods of a vast class module. Means I wanted the names of all public functions listed in the module itself in a special procedure to give the opportunity to call them by name (CallByName used; could also be DispCall).
I could use a VB6 documenter for this, but asked myself if there is any way to access the VB6 Extensibility Library from inside the IDE apart from using an add-in, which seems to be the only way to get the instance's VBE Application object - other than in VBA Office where you can access VBIDE at any time. Investigated all over the net but could not find any solution. So here is mine.
It's so small that I can post the only important code routine here:
Code:
Private ThisVBE As VBIDE.VBE
Function GetVBIDE() As VBIDE.VBE
Dim hwndMain As Long
Dim sTitle As String
Dim ret As Long
Dim hProp As Long
Dim ObjW As Object
On Error GoTo ErrHandler
If ThisVBE Is Nothing Then
hwndMain = FindWindow("wndclass_desked_gsk", vbNullString)
If hwndMain <> 0 Then
sTitle = String(255, 0)
ret = GetWindowText(hwndMain, sTitle, 255)
If ret > 0 Then
sTitle = Left(sTitle, ret)
If InStr(1, sTitle, "Microsoft Visual Basic") > 0 Then
hProp = GetProp(hwndMain, "VBAutomation")
If hProp <> 0 Then
CopyMemory ObjW, hProp, 4& '= VBIDE.Window
Set ThisVBE = ObjW.VBE
CopyMemory ObjW, 0&, 4&
End If
End If
End If
End If
End If
Set GetVBIDE = ThisVBE
Exit Function
ErrHandler:
MsgBox Err.Description, vbCritical, "GetVBIDE()"
Resume Next
End Function
Explanation:
With the help of some API functions receive the window of VB's IDE (class wndclass_desked_gsk; top level window)
Check if it's the right one ('Microsoft Visual Basic' in caption)
All IDE windows expose a windows property (long value) called "VBAutomation". I found out this to be the object pointer of the related VBIDE.Window
Get the pointer with GetProp
Turn the pointer into an object (CopyMemory)
Get the root VBE from property Window.VBE
Attached is a little project to demonstrate the usage. Hope it works in your environment.
If you want to implement this in your own project just copy the one routine and the API declarations into some module.
I knew it they hid this reference somewhere and a nice detective work by you!
I've been using my own special add-in for this purpose only to put the address of the global VBIDE.VBE into an environment variable so that it can accessed from Immediate Window at design-time with something like this
Code:
Option Explicit
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableA" (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (oDest As Any, ByVal lSrcPtr As Long) As Long
Public Property Get VbeRef() As VBIDE.VBE
Dim sBuffer As String
sBuffer = String$(50, 0)
Call GetEnvironmentVariable("_ADDIN_VBEREF" & GetCurrentProcessId(), sBuffer, Len(sBuffer) - 1)
If Val(sBuffer) <> 0 Then
Call vbaObjSetAddref(VbeRef, Val(sBuffer))
End If
End Property
Now I can safely remove my add-in a leave only MZ-Tools "poisoning" the IDE :-)) It will be the last crutch I cannot live without in the IDE.
I knew it they hid this reference somewhere and a nice detective work by you!
Thanks!
I forgot to mention that there are some restrictions on it. You can call the function from the immediate window or a module method but not from a running object. It does not work if you try to call it e.g from the sample form. That's the reason for the error handler.
Although you get successfully the VBAutomation pointer in this case you cannot access the VBIDE.Window object. VB then always raises "No permission". Maybe it's security related. I did not find a way to circumstance this.
Thank you for this very useful function.
Seems better than MZTools, in a way.
I had a few issues.
Immediate window has a limitation in the number of lines.
When I ran the function in my project, lots of lines were getting lost.
So, I put a break point and stopped for each VBC
Copy the output, paste it to a notepad.
Resume.
Not at all elegant, but did the job. Is there a way out of this?
Edit:
Hindsight: I think I proved I am a Newbie.
I just opened a file and added print statements to get the whole output directly in a file, without all that circus.
2. At one point, it gave "Runtime Error 91 -Object Variable or With Block Variable not set"
Upon investigating, I found, this was because vbc.name was blank.
So, I introduced an IF statement and got over that problem.
Code:
With GetVBIDE
Debug.Print .ActiveVBProject.BuildFileName
For Each vbc In .ActiveVBProject.VBComponents
Debug.Print vbc.Name & "..."
If vbc.Name <> "" Then
Set vbm = vbc.CodeModule
For Each mem In vbm.Members
' Debug.Print ">" & IIf(mem.Hidden, "Hidden, ", "Exposed, ") & _
IIf(mem.Browsable, "browsable, ", "non-browsable, ") & _
IIf(mem.Bindable, "bindable, ", "non-bindable, ") & _
IIf(mem.Static, "static ", "non-static "),
Debug.Print ">" & Choose(mem.Scope, "Private ", "Public ", "Friend ") & _
Choose(mem.Type, "Method ", "Property ", "Variable ", "Event ", "Constant ") & _
"""" & mem.Name & """ with DispId " & mem.StandardMethod
Next mem
Debug.Print
End If
Next vbc
Regards,
Last edited by Yakkov; Mar 30th, 2021 at 08:14 AM.
Btw, I'm currently using this property VbeRef in a standard .bas module
Code:
' Add reference to Microsoft Visual Basic 6.0 Extensibility
Option Explicit
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (oDest As Any, ByVal lSrcPtr As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Public Property Get VbeRef() As VBIDE.VBE
Static oRetVal As VBIDE.VBE
Dim hWnd As Long
Dim lProcessId As Long
Dim hProp As Long
Dim oWindow As VBIDE.Window
If oRetVal Is Nothing Then
Do
hWnd = FindWindowEx(0, hWnd, "wndclass_desked_gsk", vbNullString)
Call GetWindowThreadProcessId(hWnd, lProcessId)
Loop While hWnd <> 0 And lProcessId <> GetCurrentProcessId()
hProp = GetProp(hWnd, "VBAutomation")
If hProp <> 0 Then
Call vbaObjSetAddref(oWindow, hProp)
Set oRetVal = oWindow.VBE
End If
End If
Set VbeRef = oRetVal
End Property
. . . so this allows code like this in Immediate Window
Btw, I'm currently using this property VbeRef in a standard .bas module
Code:
' Add reference to Microsoft Visual Basic 6.0 Extensibility
Option Explicit
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (oDest As Any, ByVal lSrcPtr As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Public Property Get VbeRef() As VBIDE.VBE
Static oRetVal As VBIDE.VBE
Dim hWnd As Long
Dim lProcessId As Long
Dim hProp As Long
Dim oWindow As VBIDE.Window
If oRetVal Is Nothing Then
Do
hWnd = FindWindowEx(0, hWnd, "wndclass_desked_gsk", vbNullString)
Call GetWindowThreadProcessId(hWnd, lProcessId)
Loop While hWnd <> 0 And lProcessId <> GetCurrentProcessId()
hProp = GetProp(hWnd, "VBAutomation")
If hProp <> 0 Then
Call vbaObjSetAddref(oWindow, hProp)
Set oRetVal = oWindow.VBE
End If
End If
Set VbeRef = oRetVal
End Property
. . . so this allows code like this in Immediate Window
Code:
? VbeRef.ActiveVBProject.Name
Project1
cheers,
</wqw>
It would be great if you could use this feature in the generated exe.
This project name is required when adding custom controls dynamically
'Vertical
Set UCScrollV = TargetForm.Controls.Add(" Project1 .ucScrollBar", UCScrollVName$)
' Horizo??ntal
Set UCScrollH = TargetForm.Controls.Add(" Project1 .ucScrollBar", UCScrollHName$)
That’s not the point of this thread at all. You can retrieve current project name by raising a runtime error (e.g. Err.Raise vbObjectError) and observing the Err.Source property should be current project name.
You know? Now that we've got easy access to the VBE object from normal code, I bet there's some Tag in the VBE somewhere that would allow easy transfer of data to/from Add-Ins.
Also, there might be a way to raise some event so Add-Ins and/or normal code could signal each other. Might not even require sub-classing. I'm working on something else, but I'll look at that a bit later.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Well, the project description seems to be a pretty good place to pass data back-and-forth. The only place I see that it's used is in the Object Browser (down on the status bar), so that's no biggie.
It's also Unicode (at least while in memory). But it's not Unicode in the saved VBP file, as Unicode characters get converted to ? because the VBP file is ANSI.
Also, it's limited to 32763 characters. I guess it's 65536 bytes (with Unicode) and also needs a bit for the header and probably &H0000 Unicode terminator.
Code:
Option Explicit
'
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (oDest As Any, ByVal lSrcPtr As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
'
Private Sub Form_Load()
Dim oVBE As VBIDE.VBE
Set oVBE = VbeRef
oVBE.ActiveVBProject.Description = ChrW$(1234) & "-Test"
Debug.Print AscW(oVBE.ActiveVBProject.Description)
oVBE.ActiveVBProject.Description = String$(32763, "a") ' Anything larger than 32763 causes error.
Debug.Print Len(oVBE.ActiveVBProject.Description)
End Sub
Public Property Get VbeRef() As VBIDE.VBE
' Add reference to Microsoft Visual Basic 6.0 Extensibility.
' The Microsoft Visual Basic 6.0 Extensibility MUST be added as a project reference to use this!!!
'
Static oRetVal As VBIDE.VBE ' No need to look it up more than once.
If oRetVal Is Nothing Then
Do
Dim hWnd As Long
hWnd = FindWindowEx(0&, hWnd, "wndclass_desked_gsk", vbNullString)
Dim lProcessId As Long
GetWindowThreadProcessId hWnd, lProcessId
Loop While hWnd <> 0& And lProcessId <> GetCurrentProcessId()
Dim hProp As Long
hProp = GetProp(hWnd, "VBAutomation")
If hProp Then
Dim oWindow As VBIDE.Window
vbaObjSetAddref oWindow, hProp
Set oRetVal = oWindow.VBE
End If
End If
'
Set VbeRef = oRetVal
End Property
I'm going to explore a way to raise events we can catch now.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
I can't seem to get VBE events to raise in standard code. Here's what I was trying (just in a Form1, with the "Microsoft Visual Basic 6.0 Extensibility" reference):
Code:
Option Explicit
'
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (oDest As Any, ByVal lSrcPtr As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
'
Dim WithEvents oEvents As VBIDE.VBComponentsEvents
Private Sub Form_Load()
Set oEvents = VbeRef.Events.VBComponentsEvents(VbeRef.ActiveVBProject)
' VbeRef.ActiveVBProject.Description = ChrW$(1234) & "-Test"
' Debug.Print AscW(VbeRef.ActiveVBProject.Description)
'
'
' VbeRef.ActiveVBProject.Description = String$(32763, "a") ' Anything larger than 32763 causes error.
' Debug.Print Len(VbeRef.ActiveVBProject.Description)
End Sub
Private Sub Form_Click()
CauseVbeEventToRaise
End Sub
Public Sub CauseVbeEventToRaise()
Dim o As VBIDE.VBComponent
Set o = VbeRef.ActiveVBProject.VBComponents.Add(vbext_ct_StdModule)
VbeRef.ActiveVBProject.VBComponents.Remove o
End Sub
Private Sub oEvents_ItemAdded(ByVal VBComponent As VBIDE.VBComponent)
Debug.Print "Event raised"
End Sub
Public Property Get VbeRef() As VBIDE.VBE
' Add reference to Microsoft Visual Basic 6.0 Extensibility.
' The Microsoft Visual Basic 6.0 Extensibility MUST be added as a project reference to use this!!!
'
Static oRetVal As VBIDE.VBE ' No need to look it up more than once.
If oRetVal Is Nothing Then
Do
Dim hWnd As Long
hWnd = FindWindowEx(0&, hWnd, "wndclass_desked_gsk", vbNullString)
Dim lProcessId As Long
GetWindowThreadProcessId hWnd, lProcessId
Loop While hWnd <> 0& And lProcessId <> GetCurrentProcessId()
Dim hProp As Long
hProp = GetProp(hWnd, "VBAutomation")
If hProp Then
Dim oWindow As VBIDE.Window
vbaObjSetAddref oWindow, hProp
Set oRetVal = oWindow.VBE
End If
End If
'
Set VbeRef = oRetVal
End Property
Note that it's on the Form1's click event.
I also tried commenting out the .Remove line, just letting the modules accumulate, but nothing changed (no events).
I also tried moving all the WithEvents stuff into a standard CLS module, but same results (no events).
I can't imagine why they don't get raised, but they don't.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.