In a StackOverflow bounty the issue of using the Windows timer api arose. Obviously VBA users have the Application.OnTime but this only have resolution to one second; if you want resolution to the millisecond then you need to use the Windows API. My solution is given below.
The Window SetTimer function behaves differently from Application.OnTime in that it will repeatedly fire unless you stop it; Application.OnTime fires only once (IIRC). Luckily, in the callback procedure that is called when the timer is fired the associated event id is passed as a parameter. So it is trivial to use that event id to call KillTimer and stop further firing.
The SO questioner wanted client code to be able to utilise this as a library feature for calling clients. In the version below we do not accept calling code's function pointers (i.e. using AddressOf) because this is unsafe. Instead, the user must pass in a string that can be passed to Application.Run.
Application.Run can takes the simple name of a procedure such as "UserCallBack" which will be resolved in the scope of ThisWorkbook. If client code is in a separate workbook then the client workbook name needs also to be prepended and separated with an exclamation mark e.g. "Book1.xlsm!UserCallBack"
We stash the callbacks in a dictionary to maintain state and when the timer fires we can select the right callback function and invoke it using Application.Run
Option Explicit
Option Private Module
'* Brought to you by the Excel Development Platform blog
'* exceldevelopmentplatform.blogspot.com
Private Declare Function ApiSetTimer Lib "user32.dll" Alias "SetTimer" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function ApiKillTimer Lib "user32.dll" Alias "KillTimer" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private mdicCallbacks As New Scripting.Dictionary
Private Sub SetTimer(ByVal sUserCallback As String, lMilliseconds As Long)
Dim retval As Long ' return value
Dim lUniqueId As Long
lUniqueId = mdicCallbacks.HashVal(sUserCallback) 'should be unique enough
mdicCallbacks.Add lUniqueId, sUserCallback
retval = ApiSetTimer(Application.hWnd, lUniqueId, lMilliseconds, AddressOf TimerProc)
End Sub
Private Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, _
ByVal dwTime As Long)
ApiKillTimer Application.hWnd, idEvent
Dim sUserCallback As String
sUserCallback = mdicCallbacks.Item(idEvent)
mdicCallbacks.Remove idEvent
Application.Run sUserCallback
End Sub
'****************************************************************************************************************************************
' User code below
'****************************************************************************************************************************************
Private Sub TestSetTimer()
SetTimer "UserCallBack", 500
End Sub
Private Function UserCallBack()
Debug.Print "hello from UserCallBack"
End Function
Alternatives to Application.Run
In the above code, Application.Run is used as the mechanism to route off and callback to calling client. However, Application.Run cannot call into a class instance's method so if you really like object-orientated code then you might want to choose a different mechanism. Code is not given for these but they are not difficult and I outline them below.
Alternative to Application.Run - ThisWorkbook and CallByName
Placing a method in the ThisWorkbook module will allow it to be called from a Workbook variable. Thus you are extending the interface of the Workbook class but if the variable is declared to be of type Excel.Workbook then it won't appear in the Intellisense dropdown menu. Despite this, it's still there and still callable.
So a variant of the above timer code could store both a Workbook variable and the method (as a string) to be invoked and then use CallByName to make the call.
Alternative to Application.Run - Custom Callback Interface
The other OO friendly way to callback is to insist that calling code implement a custom callback interface. The interface would probably have just one callback method suitable for all clients. The callback interface is defined in the server code and implemented in the client code. Then the client code passes a variable typed to the custom callback interface to the server. Upon firing, the server invokes the callback method on the interface variable to make the callback.
I'm not the world's greatest cryptographer but I am surprised how easy the 16-digit credit card number is to generate, I guess the guy (Luhn) who invented it in the 1950s had little computing power. Below is some code to check a credit card number. Further below is some code to generate your own. For test data generation purposes only, no nefarious uses please.
Option Explicit
Public Function Check(ByVal ccNumber As String)
'* VBA implementation of Luhn algorithm
'* Based on a Java class from
'* https://stackoverflow.com/questions/20740444/check-credit-card-validity-using-luhn-algorithm#answer-27326507
Dim sum As Long
Dim alternate As Boolean
Dim i As Long
For i = Len(ccNumber) To 1 Step -1
Dim n As Long
n = CLng(Mid$(ccNumber, i, 1))
If alternate Then
n = n * 2
If (n > 9) Then
n = (n Mod 10) + 1
End If
End If
sum = sum + n
alternate = Not alternate
Next
Check = (sum Mod 10 = 0)
End Function
Sub TestCheck()
'* not mine from SO https://stackoverflow.com/questions/20725761/validate-credit-card-number-using-luhn-algorithm
Debug.Assert Check("4388576018410707")
End Sub
Sub GenerateTestData()
Dim lLoop As Long
Dim sStem As String
sStem = Left("4388576018410707", 1)
Dim sWork As String
sWork = sStem
Dim lDigitsToGenerate As Long
lDigitsToGenerate = 16 - Len(sWork)
Dim lRandomDigits As Long
lRandomDigits = lDigitsToGenerate - 1
For lLoop = 1 To lRandomDigits
sWork = sWork & CStr((CInt(Rnd(1) * 10) Mod 10))
Next lLoop
Debug.Assert Len(sWork) = 15
For lLoop = 0 To 9
Dim sTry As String
sTry = sWork & CStr(lLoop)
Debug.Assert Len(sTry) = 16
If Check(sTry) Then
Debug.Print sTry
Exit For
End If
Next
End Sub
If you have every authored a C# .NET class library to act as an in-process COM server Dll for use in Excel VBA then you've probably been irritated about having to close your Excel.exe session every time you wanted to rebuild the C# component. I have a fix for that, the answer is to create a COM+ application which gives a process separate to Excel.exe. I detail this in this blog post.
Also in this blog post I will show a beautiful software application called Process Explorer by Mark Russinovich of SysInternals. This beauty will track down a Dll and show which process has it loaded.
So for demonstration purposes we have a really simple C# class library with extra attributes to make it inter-operable with COM clients and thus act as an in-process COM Server Dll. The project name is ClassLibrary.
In the code below you see how we must define the interface separately (actually in VB.Net one can be more succinct but never mind). As mentioned in the comments one needs to make the assembly COM visible, check the 'Register for COM interop' checkbox on the build tab and don't forget to run Visual Studio with administrator rights so the the registration is successful.
The code does do very much. All it does is return a string "baz" pre-pended with a message about the current process id. I need the current process id to highlight the tools I'm going to demonstrate.
using System.Diagnostics;
using System.Runtime.InteropServices;
// (i) in AssemblyInfo.cs change to [assembly: ComVisible(true)]
// (ii) in the Project Properties->Build tab under the Output section ensure the 'Register for COM interop' checkbox is checked.
// (iii) You will need to run Visual Studio with admin rights so it can register the dll.
namespace ClassLibrary
{
public interface IFoo
{
string bar();
}
[ClassInterface(ClassInterfaceType.None)]
[ComDefaultInterface(typeof(IFoo))]
public class CFoo : IFoo
{
string IFoo.bar()
{
return "Current process id:" + Process.GetCurrentProcess().Id + "\nbaz";
}
}
}
and here is some client VBA code. Once the CreateObject() line is executed the Dll is loaded into the Excel.exe process space. We are using late binding but the Dll still gets locked. Once loaded into Excel.exe, it cannot be freed. Once loaded into Excel.exe, it is impossible for Visual Studio to build the project. One has to close the Excel.exe session; this can be really disruptive.
Option Explicit
Option Private Module
Private Sub Test1()
Dim obj As Object 'ClassLibrary.CFoo
Set obj = CreateObject("ClassLibrary.CFoo")
Debug.Print obj.bar
Stop
Set obj = Nothing
End Sub
Process Explorer - by Mark Russinovic, SysInternals
So during my investigations I used Process Explorer by Mark Russinovich, Sysinternals. This is a superb program that has a ton of features worth investigating in your spare time. Relevant here is the ability to sweep through processes looking for a file that has been loaded. First though we need to run the VBA client code, run this now and allow it to halt on the Stop statement. Halting gives us time to look at where its loaded.
Here is a screenshot of it finding the C# class library loaded into Excel.
I'll give a second screenshot which will successfully show the Dll loaded into a separate COM+ process. Let's move onto COM+.
COM+ (Component Services) allows surrogate hosting for in-process Dlls with a separate process
So we need to load the Dll into a separate process and the easiest way to do this is to configure a COM+ application. On the request for a configured object, COM+ will launch a separate process call DLLHost.exe and then load the COM DLL server into that process and marshal method calls thereto.
The COM+ Microsoft Management Console
It is best to dive in and look at the COM+ administration tool before talking about it, here is the steps required to open that. These are valid for Windows 10 users (and prior editions)
Open the classic Control Panel
In the classic Control Panel, click on Adminstrative Tools icon to open Adminstrative Tools explorer
In the Adminstrative Tools explorer, double-click on the Component Services icon to open the Microsoft Management Console (MMC) for Component Services
In the Microsoft Management Console (MMC) for Component Services expand the Component Services treeview node to reveal the Computers folder
Click on (and thus expand) the Computers folder treeview node to reveal the My Computer folder icon
Click on (and thus expand) the My Computer folder icon treeview node to reveal the COM+ Applications folder icon
Click on (and thus expand) the COM+ Applications folder icon treeview node to reveal the COM+ Applications
Your MMC should look something like this below
From here we can create a new Application, the steps are as following.
Right-click on the COM+ Applications folder icon treeview node to get the context menu from which select New->Application to launch the COM+ Application Install Wizard
Click Next on the front page on the launched COM+ Application Install Wizard to move to the 'Install or Create a New Application' wizard page
On the 'Install or Create a New Application' wizard page click on 'Create an empty application' which opens the 'Create Empty Application' wizard page
On the 'Create Empty Application' wizard page, enter 'MyNewApplication' for the name and ensure the Server application radio button is selected (this is key to getting a separate process).
Click 'Next' to move to the Application Identity wizard page.
Click 'Next' on the Application Identity wizard page to take the defaults and move to the Add Application Roles wizard page
Click 'Next' on the Add Application Roles wizard page to take the defaults and move to the Add Users to Roles wizard page
Click 'Next' on the Add Users to Roles wizard page to take the defaults and move to final finish page. Click Finish.
You now have a new COM+ Application, symbolised by a COM+ Application icon and labelled 'MyNewApplication'. But it has no components yet, so lets add our ClassLibrary.dll. Here are the steps.
Select the MyNewApplication COM+ application by clicking on its icon.
Expand the MyNewApplication COM+ application folder icon to reveal the contained Components folder.
Select the Components folder by clicking on its icon.
Right-click on the Components folder icon to get the context menu from which select New->Component to launch the COM+ Component Install Wizard
On the front page of the COM+ Component Install Wizard click next to move to the Import or install a component wizard page
On the Import or install a component wizard page choose 'Import component(s) that are already registered' to move to the Choose Components to Import wizard page
On the Choose Components to Import wizard page, I had to check the 32-Bit Registry checkbox before I could find ClassLibrary.CFoo
Select ClassLibrary.CFoo in the list and then click Next to move to the Finish wizard page whereupon click Finish,
Your console should now look like this...
So you now have configured your COM+ application to contain and serve instantiations of the ClassLibrary.CFoo class. ClassLibrary.Dll will be loaded in a surrogate DllHost.exe process. I will prove this by running the VBA client code again and again using Process Explorer to find the ClassLibrary.dll. YOU MUST CLOSE EXCEL.EXE AND RESTART NEW EXCEL.EXE
After closing the exiting Excel.exe session and restarting a new Excel.exe session and running the VBA client code the ClassLibrary.CFoo object was instantiated into a DllHost.exe surrogate process. Here is a screenshot proving the new location of the Dll in the DllHost.exe surrogate process (and no trace in any Excel.exe process).
More proof that the COM+ Application is running is by observing its icon in the console, it becomes an animated spinning icon!
Shutting down the COM+ Application surrogate process
So the real benefit to all this is the ability to shut the surrogate process, release the Dll from being loaded and locked and allow Visual Studio to rebuild the next version of the component. We no longer have to close the Excel session. All we need to do is shutdown the surrogate process of the COM+ Application. This is easy, here are the steps.
In the MMC, click on the MyNewApplication icon to select it.
Right-click on the MyNewApplication icon to get the context menu from which select Shutdown
There isn't much feedback to say a shutdown has happened, Process Explorer will delete the line if you are keen to see evidence. The best evidence is that Visual Studio can now rebuild the component.
One caveat, if you change the component's interface then be prepared to repeat the above configuration of the application. Other than that you can now enjoy more enduring Excel sessions; something I've got used to whilst developing Python scripts which do not lock up.
COM+ information (catalog) is NOT stored in the registry
I got a little confused about where the COM+ information was stored. I searched and search the registry but to no avail. It turns out that it is NOT stored in the registry as per this quote from the COM+ (Component Services) documentation on the COM+ catalog...
Actually, this is probably a good thing. On numerous occasions, I have had to poke around the registry to solve a COM issue. Locking up the information is probably a step in the right direction and I guess this approach previews the .NET global assembly cache.
This is second blog post demonstrating how we can use Python code to leverage a C++ reflection API with respect to a VBA project and thus confer the capabilities of reflection to a VBA programmer where no native VBA functionality exists. In other words, reflection is not normally available to a VBA developer but with some clever code we can fix that. The use case this time is converting enumerations to strings (and back).
So in the previous post I highlighted how there is no in built VBA language feature to give the string equivalent of an enumeration value; and that one had to write a helper function. But, the helper function has to be kept synchronised which can be a little painful. Luckily, we can use some more Python reflection code to help with this.
You are strongly advised to first read the prior article on Python reflection where a simpler version of the diagram below is introduced. In this post, we continue to flesh out our diagram with more hyperlinks for methods and structures we're going to use. New on this diagram is the ITypeLib interface (rightmost box). One can acquire a reference to a class's containing type library (VBA project) via the class's ITypeInfo interface by calling ITypeInfo::GetContainingTypeLib.
Being able to acquire the containing type library (VBA project) is an important advance. In the prior reflection blog post we got run-time type information (RTTI) for a single VBA class instance. But now we have the capability to interrogate the whole type library (VBA project). In this post I will give code which will find all the enumerations and write some helper functions to convert enumeration values to and from strings. I'm sure, I will blog other use cases that will make use of 'type-library-wide' information.
Another addition to the diagram below is the link to the VARDESC structure. The documentation for that structure is unwelcoming (to a VBA programmer at least), don't worry that documentation is typically for C++ programmers. We will be using a Python layer called pythoncom authored by Tim Golden. The Python layer is beautiful to work with. Thanks Tim!
Python Reflection code to query a Type Library (VBA Project) for all enumerations
So we are in a position to give the strategy for listing all the enumerations in a type library (VBA Project) given a VBA class instance from that type library.
Get the IDispatch interface pointer for given VBA class
Get the class's ITypeInfo interface pointer by calling IDispatch::GetTypeInfo
Get the type library's (VBA Project's) ITypeLib interface pointer by calling ITypeInfo::GetContainingTypeLib
Get the total count of types of the type library (VBA Project) by calling ITypeLib::GetTypeInfoCount to set up a For loop
Use a For loop to iterate over all the types in the type library (VBA Project)
On each iteration call ITypeLib::GetTypeInfo to get the ITypeInfo interface pointer for each type
Test the type's Typekind to see if it an enumeration
For each enumeration run our code to generate some VBA enumeration helpers function
PythonVBAEnumHelper.py, houses the Python COM Gateway class
So this is the Python code. It needs to be run at least once from a command line with administrator rights so that the registry can be updated. Once registered then simple use VBA.CreateObject("PythonInVBA.PythonVBAEnumHelper") to instantiate this Python class and then call the WriteMyEnumHelpers method.
import pythoncom
class PythonVBAEnumHelper(object):
_reg_clsid_ = "{232D07E5-4BCE-4FB9-93DC-2F6B58B809F7}"
_reg_progid_ = 'PythonInVBA.PythonVBAEnumHelper'
_public_methods_ = ['ClearLog','ReadEnums','ReadEnum','WriteMyEnumHelpers','WriteMyEnumHelper']
_public_attrs_ = ['Log']
_readonly_attrs_ = ['Log']
def __init__(self):
self.Log = ""
def ClearLog(self):
self.Log = ""
def GetTypeLibrary(self, o):
try:
pt = str(type(o))
if pt == "<class 'win32com.client.CDispatch'>":
ti = o._lazydata_[0]
elif pt == "<class 'PyIDispatch'>" :
ti = o.GetTypeInfo()
else:
self.Log += "called with type " + pt + " no attempt to acquire typeinfo\n"
return None
self.Log += "Acquired typeinfo:" + ti.GetDocumentation(-1)[0] + "\n"
typelib = ti.GetContainingTypeLib()[0]
self.Log += "Acquired containing typelib:" + typelib.GetDocumentation(-1)[0] + "\n"
return typelib
except Exception as e:
self.Log += "Error: " + str(e) + "\n"
def WriteMyEnumHelpers(self,o):
try:
helpers = []
enums = self.ReadEnums(o,True)
if not (enums is None):
for enum in enums:
helper = self.WriteMyEnumHelper(enum)
if not (helper is None):
helpers.append(helper)
return list(helpers)
except Exception as e:
self.Log += "Error: " + str(e) + "\n"
def WriteMyEnumHelper(self,enum):
try:
if not (enum is None):
vbaStringToEnumFuncName = enum[0] + "StringToEnum"
vbaStringToEnumFuncSrc = "Public Function " + vbaStringToEnumFuncName + "(s As String) As " + enum[0] + "\n\t" + vbaStringToEnumFuncName + " = "
vbaEnumToStringFuncName = enum[0] + "EnumToString"
vbaEnumToStringFuncSrc = "Public Function " + vbaEnumToStringFuncName + "(e As " + enum[0] + ") As String\n\t" + vbaEnumToStringFuncName + " = "
stringToEnumSwitch = ""
enumToStringSwitch = ""
srcArray = ""
for enumMem in enum[2]:
if (stringToEnumSwitch != ""):
stringToEnumSwitch+=", "
enumToStringSwitch+=", "
stringToEnumSwitch+= "s = \"" + enumMem[0] + "\", " + str(enumMem[1])
enumToStringSwitch+= "e = " + str(enumMem[1]) + ", \"" + enumMem[0] + "\""
vbaEnumToStringFuncSrc+=" Switch(" + enumToStringSwitch + ")\nEnd Function\n"
vbaStringToEnumFuncSrc+=" Switch(" + stringToEnumSwitch + ")\nEnd Function\n"
return (vbaEnumToStringFuncSrc + vbaStringToEnumFuncSrc)
else:
return "Something went wrong"
except Exception as e:
self.Log += "Error: " + str(e) + "\n"
def ReadEnums(self, o, readMembers):
try:
typelib = self.GetTypeLibrary(o)
if not (typelib is None):
enums = [[]]
for index in range(0, typelib.GetTypeInfoCount()):
ti = typelib.GetTypeInfo(index)
ta = ti.GetTypeAttr()
tk = ta.typekind
if tk == 0: # 0=ENUMERATION
self.Log += "Found enum:" + ti.GetDocumentation(-1)[0] + "\n"
members = None
if (readMembers):
members = self.ReadEnum(o,index)
tup = (ti.GetDocumentation(-1)[0],index, members)
enums.append(tup)
return enums
except Exception as e:
self.Log += "Error: " + str(e) + "\n"
def ReadEnum(self, o, index):
try:
typelib = self.GetTypeLibrary(o)
if not (typelib is None):
ti = typelib.GetTypeInfo(index)
ta = ti.GetTypeAttr()
count = ta.cVars
enumMems = []
self.Log += "Enum count:" + str(count) + "n"
for memberIndex in range(0, count):
varDesc = ti.GetVarDesc(memberIndex)
enumMems.append((ti.GetDocumentation(varDesc.memid)[0],varDesc.value))
return list(enumMems)
except Exception as e:
self.Log += "Error: " + str(e) + "\n"
def RegisterThis():
print("Registering COM servers...")
import win32com.server.register
win32com.server.register.UseCommandLine(PythonVBAEnumHelper)
if __name__ == '__main__':
RegisterThis()
print("End of execution")
VBA classes
I have contrived to split the enums over two classes. This is to demonstrate that the Python code can interrogate all Instancing '2 - PublicNotCreatable' classes in a type library (VBA Project) given just a single class instances. So forgive me if this looks a little odd. Also, do please note that enums defined is either a (i) standard module or (ii) a class with Instancing '1 - Private' will not be found. So you'll need two separate classes, Enums and MoreEnums both with Instancing '2 - PublicNotCreatable'.
The Enums VBA class
Option Explicit
'* Instancing must be set to '2 - PublicNotCreatable'
Public Enum Cars
BMW
Ford
Lotus
'Ferrari
End Enum
The MoreEnums VBA class
Option Explicit
'* Instancing must be set to '2 - PublicNotCreatable'
Public Enum MyColor
Red = 1
Green
Blue
'Yellow
'Purple
End Enum
The VBA Client code
So the Python code does the clever stuff with reflection but we still need some VBA client code to call into the Python COM server.
Option Explicit
Private Function WriteEnumsHelpers(ByVal oAnyPublic2VBAClass As Object)
Static oHelper As Object
If oHelper Is Nothing Then Set oHelper = VBA.CreateObject("PythonInVBA.PythonVBAEnumHelper")
oHelper.ClearLog
If oAnyPublic2VBAClass Is Nothing Then Err.Raise vbObjectError, "", "#Null oAnyPublic2VBAClass!"
On Error GoTo PythonComInteropErrorHandler
WriteEnumsHelpers = oHelper.WriteMyEnumHelpers(oAnyPublic2VBAClass)
'Debug.Print oHelper.Log
Exit Function
PythonComInteropErrorHandler:
If Err.Number = 98 Then
Err.Raise vbObject, "", "#oVBAClass of type '" & TypeName(oAnyPublic2VBAClass) & "' must have Instancing '2 - PublicNotCreatable'!"
Else
Debug.Print Err.Description, Hex$(Err.Number), Err.Source
Debug.Print "Log:" & oHelper.Log
End If
End Function
Private Sub TestWriteEnumsHelpers()
Dim oAnyPublic2VBAClass As Object
Set oAnyPublic2VBAClass = New Enums
Debug.Print VBA.Join(WriteEnumsHelpers(oAnyPublic2VBAClass), vbNewLine)
End Sub
Sample output
So the Python code actually generates VBA code for copying and pasting into the VBA project to help with your enumeration to string (and back again) logic.
Public Function CarsEnumToString(e As Cars) As String
CarsEnumToString = Switch(e = 0, "BMW", e = 1, "Ford", e = 2, "Lotus")
End Function
Public Function CarsStringToEnum(s As String) As Cars
CarsStringToEnum = Switch(s = "BMW", 0, s = "Ford", 1, s = "Lotus", 2)
End Function
Public Function MyColorEnumToString(e As MyColor) As String
MyColorEnumToString = Switch(e = 1, "Red", e = 2, "Green", e = 3, "Blue")
End Function
Public Function MyColorStringToEnum(s As String) As MyColor
MyColorStringToEnum = Switch(s = "Red", 1, s = "Green", 2, s = "Blue", 3)
End Function
It has been asked on Stack Overflow is there is an inbuilt way to convert a VBA enum to a string, i.e. to get a string representation of the value, like there is in C#. The answer is no. But one can write a helper function with the enum values stored in an array. (UPDATE: and in this follow-up post I give Python code to write it for you!)
In the code below I have four examples. In the first two the values are sequential, they differ only in that one is zero-based and the other isn't.
The third example is a binary flag based enumeration where the values are not mutually exclusive but instead building blocks for a composite indicator. This requires a helper function to convert the value to binary with modular division.
The fourth example is to catch all other cases because it uses a Switch statement to find the index of the correct string in the array and is less efficient.
However, all three examples require the enumeration definition to be synchronized to the array of strings. This might be considered a pain, I wonder if there is anything we can do to salve this pain?
Option Explicit
'* a sequential example zero based
Public Enum Cars
BMW
Ford
Lotus
End Enum
'* a sequential example non-zero based
Public Enum MyColor
Red = 1
Green
Blue
End Enum
'* a binary flag based
Public Enum ParamFlags
FIN = 1
FOUT = 2
FLCID = 4
FRETVAL = 8
FOPT = 16
FHASDEFAULT = 32
FHASCUSTDATA = 64
End Enum
'* non sequential, non binary flags
Public Enum PrimeNumbers
First = 2
Second = 3
Third = 5
Fourth = 7
Fifth = 11
End Enum
Public Function CarsEnumToString(e As Cars)
CarsEnumToString = Array("BMW", "Ford", "Lotus")(e)
End Function
Public Function MyColorEnumToString(e As MyColor)
MyColorEnumToString = Array("Red", "Green", "Blue")(e - 1)
End Function
Public Function ParamFlagsEnumToString(e As ParamFlags)
ParamFlagsEnumToString = ToBinary(e, Array("FIN", "FOUT", "FLCID", "FRETVAL", "FOPT", "FHASDEFAULT", "FHASCUSTDATA"))
End Function
Public Function PrimeNumbersEnumToString(e As PrimeNumbers) As String
PrimeNumbersEnumToString = Array("First", "Second", "Third", "Fourth", "Fifth")(Switch(e = 2, 0, e = 3, 1, e = 5, 2, e = 7, 3, e = 11, 4))
End Function
Function ToBinary(ByVal lFlags As Long, ByRef vNames As Variant)
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
Dim lIndex As Long
While lFlags > 0
If lFlags Mod 2 = 1 Then dic.Add dic.Count, vNames(lIndex)
lFlags = lFlags \ 2
lIndex = lIndex + 1
Wend
ToBinary = VBA.Join(dic.Items, " | ")
End Function
Sub Test()
Debug.Assert CarsEnumToString(BMW) = "BMW"
Debug.Assert CarsEnumToString(Ford) = "Ford"
Debug.Assert CarsEnumToString(Lotus) = "Lotus"
Debug.Assert MyColorEnumToString(Red) = "Red"
Debug.Assert MyColorEnumToString(Green) = "Green"
Debug.Assert MyColorEnumToString(Blue) = "Blue"
Dim e As ParamFlags
e = FIN + FOUT + FLCID + FOPT + FHASDEFAULT + FHASCUSTDATA
Debug.Assert ParamFlagsEnumToString(e) = "FIN | FOUT | FLCID | FOPT | FHASDEFAULT | FHASCUSTDATA"
Debug.Assert PrimeNumbersEnumToString(2) = "First"
Debug.Assert PrimeNumbersEnumToString(11) = "Fifth"
End Sub
In a previous post this month, I wrote that VBA does not have reflection that allows some fancy dependency injection mechanism. This is strictly true of VBA itself but VBA is a COM artefact and reflection interfaces are available as part of the venerable COM specification. Luckily, with the help of some Python we can call some of these reflection interfaces on a VBA class.
WARNING: what follows is a little known technique which I have not run in a production environment; so use at your risk. No warranty is given for any code in this blog post, nor for any blog post. But do let us know how you get on if you chose to use it by commenting below.
The high-level use-case
In this post I'll show enough Python reflection code to drive a better dependency injection mechanism. The high level logic is easy enough to express: all I need is to check a VBA class instance for a certain method named "InjectDependencies" and if found return a list of argument names which will determine what to inject. Seems simple enough but it requires delving into COM reflection interfaces which are typically unknown to a VBA developer.
Strategy - acquiring ITypeInfo from an IDispatch method and calling ITypeInfo methods
In the diagram below the left hand box shows the virtual function table of a VBA class, the class only has three user defined methods, Foo, Bar and Baz but as it is a COM class it also has an implementation of IUnknown. Also because VBA classes can be late bound we know they support IDispatch, the methods of which come after the methods of IUnknown. Then come the user-defined methods, so Foo is in fact the 8th method in this virtual function table.
I want to attract your attention to the IDispatch methods. Maybe you're already familiar with the IDispatch methods GetIDsOfNames and Invoke; these implement late binding. Less well known, I would argue, are the other two IDispatch methods GetTypeInfoCount and GetTypeInfo but I believe these methods deserve high praise and more attention as they return run time type information (RTTI). In fact, I believe these methods are what allow rich reports on a late bound object's properties in the Locals or Watch windows.
In fact, GetTypeInfoCount is just a guard which returns 0 or 1. The real method is GetTypeInfo which returns a pointer to ITypeInfo. Our code will acquire a pointer to ITypeInfo by calling IDispatch::GetTypeInfo.
The Dual Interface and the need to hop from one ITypeInfo to another
If you have worked with the C# reflection classes you will probably smirk at the ITypeInfo interfaces particularly in this next case. A COM class can have dual interface meaning it can be accessed either via IDispatch or through its virtual function table (vtable) interface. Thus, dual interfaces require two separate ITypeInfo interface instances. IDispatch::GetTypeInfo returns a Dispatch ITypeInfo interface instance but we hop to ITypeInfo for the vtable interface instance with a call to GetRefTypeOfImplType and then GetRefTypeInfo. Please don't ask me to defend this API design.
Getting the TypeAttr structure
There is plenty of information on the TypeAttr structure which is acquired by calling ITypeInfo::GetTypeAttr. The Python library will handle releasing the structure's memory. On the TypeAttr structure, we are interested in cFuncs which is the count of functions (aka methods).
Looping through function descriptions and then acquiring parameter names
Knowing the count of functions/methods we can loop through and for each method acquire the function description, FUNCDESC, structure. (Again, the Python layer will release the structure for us.) We call GetDocumentation to examine the method name (first element on the returned tuple). If we find "InjectDependencies" then we take note of the index number; later we call GetNames to return the list of arguments.
The Python Com Server
So what follows is a Python COM Server aka gateway class, I have placed many examples of these on this blog. But for those new to this, this will implement a COM server that is create-able from VBA using CreateObject(). In the class below the code maintains a log because it can be quite difficult to communicate what is going on without a log.
The strategy outlined above is implemented in ReadParams() which takes a single parameter (the self keyword is what holds the state of a a Python class instance), o which should be a VBA class instance. Please pass a real VBA class and not a document class such as ThisWorkbook or Sheet1. Also for the VBA class the Instancing needs to be '2 - PublicNotCreatable' for reasons I have yet to confirm.
The opening lines of ReadParams() are defensive type checking. The key call is GetTypeInfo() which returns a pointer to ITypeInfo. If you know the strategy, the rest of the code should be easy to follow.
If you have written .NET reflection code in C# then you are lucky, it is very intuitive and easy to understand. The COM reflection interfaces are very far from intuitive, IMHO; especially if you are writing in C++. The COM reflection API can be quite painful. So be thankful that some Python contributors (Tim Golden et al.) have added a layer to insulate you from the C++ complexities. For more information here is the Python documentation.
Upon re-reading my code, I think a few lines could be taken out to make it tighter, perhaps quit the loop early if a method match is found.
Finally, on a COM interop note, Python tuples need to be converted to lists for passing back to the calling VBA, where they are marshalled to a Variant array.
import pythoncom
class PythonDependencyInjectionHelper(object):
_reg_clsid_ = "{2AFE4143-AC58-4D1F-A172-9D20C917D13A}"
_reg_progid_ = 'PythonInVBA.PythonDependencyInjectionHelper'
_public_methods_ = ['ReadParams','ClearLog']
_public_attrs_ = ['Log']
_readonly_attrs_ = ['Log']
def __init__(self):
self.Log = ""
def ClearLog(self):
self.Log = ""
def ReadParams(self, o):
try:
pt = str(type(o))
if pt == "<class 'win32com.client.CDispatch'>":
ti = o._lazydata_[0]
elif pt == "<class 'PyIDispatch'>" :
ti = o.GetTypeInfo()
else:
self.Log += "called with type " + pt + " no attempt to acquire typeinfo\n"
return None
self.Log += "Acquired typeinfo:" + ti.GetDocumentation(-1)[0] + "\n"
ta = ti.GetTypeAttr()
tk = ta.typekind
if tk == 4:
try:
tivt = ti.GetRefTypeInfo(ti.GetRefTypeOfImplType(-1))
tavt = tivt.GetTypeAttr()
except Exception as ex:
raise Exception("Error whilst acquiring vtable interface " + str(ex))
try:
idx = -1
for funcIdx in range(0, tavt.cFuncs):
fd = tivt.GetFuncDesc(funcIdx)
if (ti.GetDocumentation(fd.memid)[0] == "InjectDependencies"):
idx = funcIdx
except Exception as ex:
raise Exception("Error whilst looping through functions " + str(ex))
if (idx != -1):
fd = tivt.GetFuncDesc(idx)
return list(tivt.GetNames(fd.memid)[1:])
except Exception as e:
self.Log += "Error: " + str(e) + "\n"
def RegisterThis():
print("Registering COM servers...")
import win32com.server.register
win32com.server.register.UseCommandLine(PythonDependencyInjectionHelper)
if __name__ == '__main__':
RegisterThis()
print("End of execution")
The TaxCalculator business logic class
Lets give some client VBA code, enough to drive the demo so I have a business logic class called TaxCalculator which has a method called InjectDependencies() which has two arguments oLogger and oIdentity. It has some simple business logic but that's not the real focus, the real focus is the injection of dependencies.
Option Explicit
Private mobjLogger As Object
Private mobjIdentity As Object
Public Sub InjectDependencies(oLogger, oIdentity)
Set mobjLogger = oLogger
Set mobjIdentity = oIdentity
End Sub
Public Function CalculateTax(ByVal lAmount As Long) As Long
If mobjIdentity.HasPermission("Taxcalc") Then
CalculateTax = lAmount * 0.2
mobjLogger.Log "Authorised, Calculated tax at 20%"
Else
mobjLogger.Log "Not authorised to run this"
End If
End Function
The Calling VBA Code
Private Function ReadDependencies(ByVal oVBAClass As Object) As Variant
ReadDependencies = CreateObject("Scripting.Dictionary").Keys '# sets a default return value for error cases
Static oHelper As Object
If oHelper Is Nothing Then Set oHelper = VBA.CreateObject("PythonInVBA.PythonDependencyInjectionHelper")
oHelper.ClearLog
If oVBAClass Is Nothing Then Err.Raise vbObjectError, "", "#Null oVBAClass!"
On Error GoTo PythonComInteropErrorHandler
Dim vDependencies
vDependencies = oHelper.ReadParams(oVBAClass)
If Not IsNull(vDependencies) Then ReadDependencies = vDependencies
Exit Function
PythonComInteropErrorHandler:
If Err.Number = 98 Then
Err.Raise vbObject, "", "#oVBAClass of type '" & TypeName(oVBAClass) & "' must have Instancing '2 - PublicNotCreatable'!"
Else
Debug.Print Err.Description, Hex$(Err.Number), Err.Source
Debug.Print "Log:" & oHelper.Log
End If
End Function
Private Sub TestReadDependencies()
Dim objVBAClass As Object
Set objVBAClass = New TaxCalculator
Dim vDependencies
vDependencies = ReadDependencies(objVBAClass)
Debug.Print Join(vDependencies, vbNewLine)
End Sub
