Results 1 to 20 of 20

Thread: [RESOLVED] VBA vs VB6 ... detection

  1. #1

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,855

    Resolved [RESOLVED] VBA vs VB6 ... detection

    Ok, here's a fun one.

    I've got a module I share between VB6 and the VBA in an Excel file. I keep the "master" in VB6, but things are setup such that a straight copy-paste is used to put updates into the Excel VBA code.

    And just now (during some debugging), I put my InIDE test in this module (for VB6). That was fine, but then it dawned on me that that won't work when I paste the module into the VBA.

    So, I need a IsThisVB6orVBA function.

    I'm sure I could work it out, but I thought I'd see what you guys come up with.

    Thanks,
    Elroy

    EDIT1: And just to be clear, let's say it returns TRUE if it's VB6 (and false if it's VBA). It should return TRUE in VB6 whether we're running from the IDE or compiled.

    EDIT2: I suppose it would be cool if it returned one of three conditions, possibly described by the following enumeration:

    Code:
    
    Public Enum TheEnvironmentEnum
        InVB6Ide
        InVB6Compiled
        InVBA
    End Enum
    
    

    EDIT3: And just as an FYI, if you work out a solution that uses API calls, that's fine. However, I'll have to make sure those calls use the PtrSafe and LongPtr stuff, as this Excel file in particular is sometimes used in an Office-64-bit environment.
    Last edited by Elroy; Feb 15th, 2019 at 03:16 PM.
    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.

  2. #2
    Frenzied Member
    Join Date
    Apr 2012
    Posts
    1,253

    Re: VBA vs VB6 ... detection

    This may be a tad simplistic but can't you just check for something that is available to VB6 but not to VBA. The Screen object, for example.
    If you don't know where you're going, any road will take you there...

    My VB6 love-children: Vee-Hive and Vee-Launcher

  3. #3
    PowerPoster
    Join Date
    Feb 2012
    Location
    West Virginia
    Posts
    14,205

    Re: VBA vs VB6 ... detection

    I really don't do anything in Excel VBA so not sure what options may be there.
    My first thought for detecting that it is running in the IDE is to add a simple command line parameter in the project properties then check for it at launch. It will only be there when running from the IDE. I have no idea if Excel has a similar option but if it does then that should be a simple solution.

  4. #4

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,855

    Re: VBA vs VB6 ... detection

    Hmmm, I do appreciate the thoughts. Regarding detecting an object, I can't get compiled (not even p-code compiled) if the object isn't there. And, regarding a command-line directive, that would cause me immense problems for all the people who have shortcuts to my program. My program runs "portable", so they typically do updates by just copying in a new executable, so something on the command line wouldn't be workable.

    For the time being, I've just solved it by putting this function in the Excel VBA in a non-shared module:

    Code:
    
    Public Function InIde6() As Boolean
        ' We put this here so we can use this InIde6 function in the shared module within the VB6 IDE.
        InIde6 = False
    End Function
    
    

    However, I wouldn't mind a more robust solution, one that could possibly be placed into that shared module.

    Thanks,
    Elroy
    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.

  5. #5
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VBA vs VB6 ... detection

    VBA 64bit has conditional compiler constants
    Code:
     #If VBA7 Then 
        Declare PtrSafe Sub... 
        Const Vversion = 7    ' VBA 64 bit, unless VB6 project uses a VBA7 compiler constant, this should be good to go
     #Else 
     Declare Sub... 
        Const Vversion = 6 ' VBA or VB6
     #EndIf
    That should get you part of the way there. If you need to distinguish VBA 32bit and VB6, you'll need a bit more there
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  6. #6
    Frenzied Member
    Join Date
    Apr 2012
    Posts
    1,253

    Re: VBA vs VB6 ... detection

    Quote Originally Posted by Elroy View Post
    Hmmm, I do appreciate the thoughts. Regarding detecting an object, I can't get compiled (not even p-code compiled) if the object isn't there.
    You can if you define it as an Object with your function and then attempt to late-bind it to a Screen Object, trapping any resulting errors, no?
    If you don't know where you're going, any road will take you there...

    My VB6 love-children: Vee-Hive and Vee-Launcher

  7. #7

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,855

    Re: VBA vs VB6 ... detection

    @LaVolpe: Oh yes, 99% of my users are still on Office 32-bit (as am I). The real problem is just distinguishing whether my code is running in VB6 or VBA.

    @Colin: I'm still not sure I see it. For instance, I still can't get something like the following compiled in the VBA:

    Code:
    
    Public Function Detect() As Boolean
        Dim o As Object
        On Error GoTo Problem
        Set o = Screen
        Detect = True
    Problem:
    End Function
    
    
    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.

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

    Re: VBA vs VB6 ... detection

    Quote Originally Posted by LaVolpe View Post
    VBA 64bit has conditional compiler constants
    Code:
     #If VBA7 Then 
        Declare PtrSafe Sub... 
        Const Vversion = 7    ' VBA 64 bit, unless VB6 project uses a VBA7 compiler constant, this should be good to go
     #Else 
     Declare Sub... 
        Const Vversion = 6 ' VBA or VB6
     #EndIf
    That should get you part of the way there. If you need to distinguish VBA 32bit and VB6, you'll need a bit more there
    I was under the impression that VBA7 is declared both with x64 and 32-bit VBA and that you always use Private Declare PtrSafe Sub CopyMemory Lib "kernel32" ... in the newer VBA versions. It's the Win64 preprocessor const that distinguishes between bitness.

    So VBA7 can be used for no cost detection, contrary to GetModuleHandle calls I suppose.

    cheers,
    </wqw>

  9. #9
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VBA vs VB6 ... detection

    Quote Originally Posted by wqweto View Post
    I was under the impression that VBA7 is declared both with x64 and 32-bit VBA
    Ah, correct. VBA7 can be used do detect VBA7, don't know about future versions so is this scalable?
    Win64 constant can help determine whether PtrSafe is required or not. PtrSafe works on both 32bit & 64bit VBA7
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  10. #10
    Frenzied Member
    Join Date
    Apr 2012
    Posts
    1,253

    Re: VBA vs VB6 ... detection

    Quote Originally Posted by Elroy View Post
    @LaVolpe: Oh yes, 99% of my users are still on Office 32-bit (as am I). The real problem is just distinguishing whether my code is running in VB6 or VBA.

    @Colin: I'm still not sure I see it. For instance, I still can't get something like the following compiled in the VBA:

    Code:
    
    Public Function Detect() As Boolean
        Dim o As Object
        On Error GoTo Problem
        Set o = Screen
        Detect = True
    Problem:
    End Function
    
    
    Oh, perhaps I'm mistaken. I don't have access to VBA right now (no Office installed), but was under the impression that VBA code was not compiled and, therefore, the function which you posted would only error when it was called (whilst working fine in VB6, of course, because the Screen object is valid there).
    If you don't know where you're going, any road will take you there...

    My VB6 love-children: Vee-Hive and Vee-Launcher

  11. #11
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VBA vs VB6 ... detection

    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  12. #12

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,855

    Re: VBA vs VB6 ... detection

    YES! I was already on it. Wqweto, thanks, you totally got me on the correct track. Here's my solution:

    Code:
    
    Option Explicit
    
    #If VBA6 Or VBA7 Then
        Public Const InVBA = True
    #Else
        Public Const InVBA = False
    #End If
    
    
    Public Sub ReportVBA()
        If InVBA Then
            MsgBox "We're in the VBA"
        Else
            MsgBox "We're NOT in the VBA"
        End If
    End Sub
    
    
    

    Thanks,
    Elroy
    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.

  13. #13
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: [RESOLVED] VBA vs VB6 ... detection

    Oh, thank everyone else except the person that mentioned those constants -- jeez. Just kidding.

    Elroy, if a VBA8 or something comes along the road, you'll need to deal with that too. I don't know when VBA introduced the VBA6 constant, but I did find this posting ... in its entirety:
    I ran the following code in Word 2003, Word 2007, and Word 2010:

    Sub CheckConstants()
    Debug.Print "Office version " & Application.Version

    #If VBA6 Then
    Debug.Print "VBA6 is True"
    #Else
    Debug.Print "VBA6 is False"
    #End If

    #If VBA7 Then
    Debug.Print "VBA7 is True"
    #Else
    Debug.Print "VBA7 is False"
    #End If
    End Sub

    These are the results:

    Office version 11.0
    VBA6 is True
    VBA7 is False

    Office version 12.0
    VBA6 is True
    VBA7 is False

    Office version 14.0
    VBA6 is True
    VBA7 is True
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  14. #14

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,855

    Re: [RESOLVED] VBA vs VB6 ... detection

    @Colin: Just as an FYI. The VBA is absolutely compiled. However, it's just p-code compiled, similar to what happens in the VB6 IDE when we execute from there.

    Name:  Compile.png
Views: 660
Size:  29.0 KB

    Thanks,
    Elroy
    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.

  15. #15

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,855

    Re: [RESOLVED] VBA vs VB6 ... detection

    hahaha, ok ok. THANKS LaVolpe.

    EDIT: And yeah, I'll deal with a VB8 constant when it comes along.
    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.

  16. #16
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: [RESOLVED] VBA vs VB6 ... detection

    Just FYI. You might want to consider using the constants throughout your code

    Instead of setting a constant, use those statements in your code
    Code:
    Option Explicit
    
    #If VBA6 Or VBA7 Then
        Public Const InVBA = True
    #Else
        Public Const InVBA = False
    #End If
    For example, let's say you have a Sub something like this simple one
    Code:
    Private Sub DoSomething()
    #If VBA7 Then
        Dim X as LngLng
    #Else
        Dim X As Long
    #End If
      ...
    End Sub
    The idea is that only the appropriate lines of code are compiled when run and one class/module can be used in VBA6, VBA7 or VB6,. Just thinking out loud. Not really sure what you plan on doing with the VBA/VB6 detection, within a production environment, so this comment may be out in left field.

    P.S. If a VBA8 is introduced, VBA7 may still return True for quite some time thereafter
    Last edited by LaVolpe; Feb 15th, 2019 at 04:45 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  17. #17

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,855

    Re: [RESOLVED] VBA vs VB6 ... detection

    Hi LaVolpe,

    I'm not sure why, but I've always avoided those compiler directives unless I absolutely needed them. I'll admit that there are a couple of places I use them, but they're not my first choice.

    And, what you outlined isn't exactly the situation I was in. Here's a small snippet of code where I stuck my InIde6 function in that shared module:

    Code:
    
        lInc i: XlsPlotFileArr(i).ChtName = "PelvicProgressAngle":                      XlsPlotFileArr(i).DataCol = "RZ": XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "CU": XlsPlotFileArr(i).NormCol = "FN": XlsPlotFileArr(i).ChtShortTitle = "Pelvic Progression"
        lInc i: XlsPlotFileArr(i).ChtName = "KneeProgressAngle":                        XlsPlotFileArr(i).DataCol = "SA": XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "CV": XlsPlotFileArr(i).NormCol = "FO": XlsPlotFileArr(i).ChtShortTitle = "Knee Progression"
        lInc i: XlsPlotFileArr(i).ChtName = "AnkleProgressAngle":                       XlsPlotFileArr(i).DataCol = "SB": XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "CW": XlsPlotFileArr(i).NormCol = "FP": XlsPlotFileArr(i).ChtShortTitle = "Ankle Progression"
        lInc i: XlsPlotFileArr(i).ChtName = "TibiaSagAngleAbsWithKneeDerot":            XlsPlotFileArr(i).DataCol = "SC": XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "CX": XlsPlotFileArr(i).NormCol = "FQ": XlsPlotFileArr(i).ChtShortTitle = "Tibia Sag Abs w Knee Derot"
        lInc i: XlsPlotFileArr(i).ChtName = "TibiaSagAngleAbsWithAnkleDerot":           XlsPlotFileArr(i).DataCol = "SD": XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "CY": XlsPlotFileArr(i).NormCol = "FR": XlsPlotFileArr(i).ChtShortTitle = "Tibia Sag Abs w Ankle Derot"
        '
        lInc i: XlsPlotFileArr(i).ChtName = "Gastroc":                                  XlsPlotFileArr(i).DataCol = "C":  XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "C":  XlsPlotFileArr(i).NormCol = "C":  XlsPlotFileArr(i).ChtShortTitle = "Gastroc Length"
        lInc i: XlsPlotFileArr(i).ChtName = "Soleus":                                   XlsPlotFileArr(i).DataCol = "D":  XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "D":  XlsPlotFileArr(i).NormCol = "D":  XlsPlotFileArr(i).ChtShortTitle = "Soleus Length"
        lInc i: XlsPlotFileArr(i).ChtName = "PosteriorTib":                             XlsPlotFileArr(i).DataCol = "E":  XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "E":  XlsPlotFileArr(i).NormCol = "E":  XlsPlotFileArr(i).ChtShortTitle = "Posterior Tib Length"
        lInc i: XlsPlotFileArr(i).ChtName = "GluteusMaxAvg":                            XlsPlotFileArr(i).DataCol = "F":  XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "F":  XlsPlotFileArr(i).NormCol = "F":  XlsPlotFileArr(i).ChtShortTitle = "Gluteus Max Length"
        lInc i: XlsPlotFileArr(i).ChtName = "Psoas":                                    XlsPlotFileArr(i).DataCol = "G":  XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "G":  XlsPlotFileArr(i).NormCol = "G":  XlsPlotFileArr(i).ChtShortTitle = "Psoas Length"
        lInc i: XlsPlotFileArr(i).ChtName = "RectusFemoris":                            XlsPlotFileArr(i).DataCol = "H":  XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "H":  XlsPlotFileArr(i).NormCol = "H":  XlsPlotFileArr(i).ChtShortTitle = "Rectus Femoris Length"
        lInc i: XlsPlotFileArr(i).ChtName = "MedialHamstring":                          XlsPlotFileArr(i).DataCol = "I":  XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "I":  XlsPlotFileArr(i).NormCol = "I":  XlsPlotFileArr(i).ChtShortTitle = "Medial Ham Length"
        lInc i: XlsPlotFileArr(i).ChtName = "BicepsFemLong":                            XlsPlotFileArr(i).DataCol = "J":  XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "J":  XlsPlotFileArr(i).NormCol = "J":  XlsPlotFileArr(i).ChtShortTitle = "Biceps Fem Long Length"
        lInc i: XlsPlotFileArr(i).ChtName = "VastusLat":                                XlsPlotFileArr(i).DataCol = "K":  XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "K":  XlsPlotFileArr(i).NormCol = "K":  XlsPlotFileArr(i).ChtShortTitle = "Vastus Lateralis Length"
        lInc i: XlsPlotFileArr(i).ChtName = "Gracilis":                                 XlsPlotFileArr(i).DataCol = "L":  XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "L":  XlsPlotFileArr(i).NormCol = "L":  XlsPlotFileArr(i).ChtShortTitle = "Gracilis Length"
        lInc i: XlsPlotFileArr(i).ChtName = "BicepsFemShort":                           XlsPlotFileArr(i).DataCol = "M":  XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "M":  XlsPlotFileArr(i).NormCol = "M":  XlsPlotFileArr(i).ChtShortTitle = "Biceps Fem Short Length"
        lInc i: XlsPlotFileArr(i).ChtName = "VastusMed":                                XlsPlotFileArr(i).DataCol = "N":  XlsPlotFileArr(i).SeriesGroupCount = 12: XlsPlotFileArr(i).EventsCol = "N":  XlsPlotFileArr(i).NormCol = "N":  XlsPlotFileArr(i).ChtShortTitle = "Vastus Medialis Length"
    
    
    
        '
        If InIde6 Then If i <> LastGcdArrayEnum - 1 Then MsgBox "Error, the XlsPlotFileArr isn't DIMMED the same as the GcdAndXlsArraysEnum, and this is critical!"
    
    
    
    

    It's that last line. I'm in the process of adding more of those lines, and I put that last check in there just to make sure I kept my head screwed on straight. And then, I pasted it all into the Excel VBA ... and OOPS.

    I've now got that last line replaced with the following:

    Code:
    
        If TheRunEnviron = InVB6Ide Then If i <> LastGcdArrayEnum - 1 Then MsgBox "Error, the XlsPlotFileArr isn't DIMMED the same as the GcdAndXlsArraysEnum, and this is critical!"
    
    

    And I've also got this stuff included in my "shared" module:

    Code:
    
    Option Explicit
    Option Private Module
    
    
    
    Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleW" (ByVal lpModuleName As Long) As Long   ' Won't be called unless in VB6.
    Public Enum TheRunEnvironEnum
        InVB6Ide
        InVB6Comp
        InVBA
    End Enum
    #If False Then ' Intellisense fix.
        Dim InVB6Ide, InVB6Comp, InVBA
    #End If
    #If VBA6 Or VBA7 Then
        Public Const InTheVBA = True
    #Else
        Public Const InTheVBA = False
    #End If
    
    
    
    Public Function TheRunEnviron() As TheRunEnvironEnum
        Select Case True
        Case InTheVBA:                              TheRunEnviron = InVBA
        Case GetModuleHandle(StrPtr("vba6")) <> 0&: TheRunEnviron = InVB6Ide
        Case Else:                                  TheRunEnviron = InVB6Comp
        End Select
    End Function
    
    
    

    That's pretty much exactly what I was hoping for.

    Oh, and by the way, those long lines are explicitly for irritating Dilettante.

    Thanks,
    Elroy

    EDIT1: Ok, I suppose I could have surrounded my original line with something like: #If Not (VBA6 Or VBA7) Then
    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.

  18. #18
    PowerPoster
    Join Date
    Feb 2012
    Location
    West Virginia
    Posts
    14,205

    Re: VBA vs VB6 ... detection

    Quote Originally Posted by Elroy View Post
    And, regarding a command-line directive, that would cause me immense problems for all the people who have shortcuts to my program.
    Like I said I have no idea if excel supports it or not but the way VB can use it would have 0 impact on your users unless of course you are providing them with the source code and not the vbp file

    If you set a command line argument in the project properties then any time it is ran in the ide you get that command line argument, when compiled you do not so if present you would know it was in the IDE, of course it could be fooled by adding the argument to the command line when running the exe as well but...

    Looks like you found a way to do what you need though so no need to explore.

  19. #19
    Frenzied Member
    Join Date
    Apr 2012
    Posts
    1,253

    Re: [RESOLVED] VBA vs VB6 ... detection

    Quote Originally Posted by Elroy View Post
    @Colin: Just as an FYI. The VBA is absolutely compiled. However, it's just p-code compiled, similar to what happens in the VB6 IDE when we execute from there.
    Ah, fair enough. Haven't used VBA in eons but it was my recollection that, the way I used it back then, certain errors that a compiler would catch would only be encountered at run-time.
    If you don't know where you're going, any road will take you there...

    My VB6 love-children: Vee-Hive and Vee-Launcher

  20. #20
    Member
    Join Date
    Mar 2018
    Posts
    35

    Re: [RESOLVED] VBA vs VB6 ... detection

    Hello.

    About four years I use the construction below in my universal (for VB6 & Office) Add-In.
    There was no issues at all.
    However the main environment where it intensively used is the bundle of both 32-bit 2003 Win & Office.
    Hope it will be useful for somebody in simple cases.

    Code:
    Public Function fpx_HstTyp(pHostVBE As VBIDE.VBE) As Byte
    Dim iReadOnlyMode%
    Dim tHst As Byte
    On Error GoTo ErH
        
        iReadOnlyMode = pHostVBE.ReadOnlyMode
        tHst = TYPVB6
        
    ErX:
        fpx_HstTyp = tHst
        Exit Function
    ErH:
        tHst = BT0
        With Err
            Select Case .Number
                Case 438 ' - Object doesn't support this property or method
                    tHst = TYPVBA
                Case Else
                    Debug.Print "Err_" & .Number & "_" & .Description & "_"
                    Stop
            End Select
        End With
        Resume ErX
    End Function
    .

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