Results 1 to 11 of 11

Thread: Access the VBIDE library without add-ins

  1. #1

    Thread Starter
    Junior Member SaschaT's Avatar
    Join Date
    Mar 2017
    Location
    Berlin, Germany
    Posts
    23

    Lightbulb Access the VBIDE library without add-ins

    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.
    Attached Files Attached Files

  2. #2
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Access the VBIDE library without add-ins

    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.

    cheers,
    </wqw>

  3. #3

    Thread Starter
    Junior Member SaschaT's Avatar
    Join Date
    Mar 2017
    Location
    Berlin, Germany
    Posts
    23

    Re: Access the VBIDE library without add-ins

    Quote Originally Posted by wqweto View Post
    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.

  4. #4
    Member
    Join Date
    Jan 2021
    Posts
    46

    Re: Access the VBIDE library without add-ins

    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.

  5. #5
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    323

    Re: Access the VBIDE library without add-ins

    Debug.Print change to a subroutine WriteFile

  6. #6
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Access the VBIDE library without add-ins

    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>

  7. #7
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    673

    Re: Access the VBIDE library without add-ins

    Quote Originally Posted by wqweto View Post
    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$)

  8. #8
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Access the VBIDE library without add-ins

    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.

  9. #9
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Access the VBIDE library without add-ins

    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.

  10. #10
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Access the VBIDE library without add-ins

    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.

  11. #11
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Access the VBIDE library without add-ins

    Well boo.

    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.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width