VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "API_Python" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False '================ Python process object ========================= ' Shared module version: 20220713 ' Tested in: PythonManager ' Depends on: ' Required reference: Option Explicit Private Const CONCEPT_DLL_LOCATION = "C:\Tools\dll" #If Win64 Then Private Const PY_DLL_NAME As String = "vbatopy-connector64.dll" Private Declare PtrSafe Function StartPythonServer Lib "vbatopy-connector64.dll" ( _ ByRef vResult As Variant, _ ByVal sPython As String, _ ByVal sModules As String, _ ByVal bShowConsole As Long) As Long Private Declare PtrSafe Function KillPythonServer Lib "vbatopy-connector64.dll" Alias "KillServer" () As Long Private Declare PtrSafe Function GetServer Lib "vbatopy-connector64.dll" (ByRef vResult As Variant) As Long #Else Private Const PY_DLL_NAME As String = "vbatopy-connector32.dll" Private Declare PtrSafe Function StartPythonServer Lib "vbatopy-connector32.dll" ( _ ByRef vResult As Variant, _ ByVal sPython As String, _ ByVal sModules As String, _ ByVal bShowConsole As Long) As Long Private Declare PtrSafe Function KillPythonServer Lib "vbatopy-connector32.dll" Alias "KillServer" () As Long Private Declare PtrSafe Function GetServer Lib "vbatopy-connector32.dll" (ByRef vResult As Variant) As Long #End If Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal sLibrary As String) As Long Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal nLibraryHandle As Long) As Long Private python_ As Variant Private pythonPath_ As String Private modules_ As String Private showConsole_ As Boolean Private Sub Class_Initialize() Call ClearCahce End Sub Private Sub Class_Terminate() Call ClearCahce End Sub Public Function ClearCahce() Set python_ = Nothing End Function ' Initialize Python process ' iPython - path to python / python command ' sModules - path to python source code modules, delimiter = ';' ' bDoDebug - flag to show console output for python process Public Function Init(iPython$, sModules$, Optional bDoDebug As Boolean = False) Set python_ = Nothing pythonPath_ = VBA.LCase(iPython) pythonPath_ = VBA.Replace(pythonPath_, "program files (x86)", """program files (x86)""") pythonPath_ = VBA.Replace(pythonPath_, "program files", """program files""") pythonPath_ = VBA.Replace(pythonPath_, "\", "\\") modules_ = sModules showConsole_ = bDoDebug End Function ' Validate server is running ' If @python_ is not setup, then load current server dispatch into @python_ Public Function Validate() As Boolean Call LoadDLL Call GetServer(python_) Validate = Not python_ Is Nothing End Function Public Function StartServer() Call Validate If Not python_ Is Nothing Then _ Exit Function If StartPythonServer(python_, pythonPath_, modules_, IIf(showConsole_, 1, 0)) <> 0 Then _ Call RaiseServerError If VBA.VarType(python_) = vbString Then Call RaiseServerError Set python_ = Nothing End If End Function Public Function KillServer() Call Validate If python_ Is Nothing Then _ Exit Function If KillPythonServer() <> 0 Then _ Call RaiseServerError Set python_ = Nothing End Function ' Preload Python module before using it - use if long setup is needed to load module Public Function LoadModule(sFullPath$) As Boolean On Error GoTo HANDLE_ERROR LoadModule = Py.ImportModule(sFullPath) <> "" On Error GoTo 0 Exit Function HANDLE_ERROR: Debug.Print Err.Description LoadModule = False On Error GoTo 0 End Function ' Run python command Public Function Execute(sPyCommand$) As Boolean On Error GoTo HANDLE_ERROR Call Py.Exec("" & sPyCommand & "") On Error GoTo 0 Execute = True Exit Function HANDLE_ERROR: Debug.Print Err.Description Execute = False On Error GoTo 0 End Function ' Evaluate python statement ' Warning! Returns only basic types. Objects are not supported Public Function Evaluate(sPyStatement$) As Variant On Error GoTo HANDLE_ERROR Evaluate = Py.Eval("" & sPyStatement & "") On Error GoTo 0 Exit Function HANDLE_ERROR: Debug.Print Err.Description Evaluate = Err.Description On Error GoTo 0 End Function ' Call function from module. Arguments will be available from python including COM wrappers for any Office objects ' Warning! Returns basic types. To get objects from python use CallFunctionReturnObject Public Function CallFunction(sModule$, sFunc$, Optional vArgs As Variant) As Variant On Error GoTo HANDLE_ERROR If IsMissing(vArgs) Then CallFunction = Py.CallFunction(sModule, sFunc) Else CallFunction = Py.CallFunction(sModule, sFunc, vArgs) End If On Error GoTo 0 Exit Function HANDLE_ERROR: Debug.Print Err.Description CallFunction = Err.Description End Function Public Function CallFunctionReturnObject(sModule$, sFunc$, Optional vArgs As Variant) As Object On Error GoTo HANDLE_ERROR If IsMissing(vArgs) Then Set CallFunctionReturnObject = Py.CallFunction(sModule, sFunc) Else Set CallFunctionReturnObject = Py.CallFunction(sModule, sFunc, vArgs) End If On Error GoTo 0 Exit Function HANDLE_ERROR: Debug.Print Err.Description Set CallFunctionReturnObject = Nothing End Function ' Create VBA wrapper for target Python module in destination file path Public Function WrapPython(sSourceModule$, sDestination$) As String WrapPython = Py.WrapPython(sSourceModule, sDestination) End Function ' Preload @vbatopy DLL ' Note: Mostly usefull for testing setup because it allows using DLL calls without starting a server Public Function LoadDLL() If LoadLibrary(PY_DLL_NAME) <> 0 Then _ Exit Function If LoadLibrary(CONCEPT_DLL_LOCATION & "\" & PY_DLL_NAME) <> 0 Then _ Exit Function ' TODO: remove fallback after some time ' fallback path for earlier versions of distribution If LoadLibrary(VBA.Environ("USERPROFILE") & "\.concept\dll\" & PY_DLL_NAME) = 0 Then _ Call Err.Raise(1, Description:="Could not load " & PY_DLL_NAME) End Function ' Unload DLL - need to call this before replacing dll file Public Function UnloadDLL() Dim nHandle&: nHandle = LoadLibrary(PY_DLL_NAME) If nHandle <> 0 Then Call KillServer Call FreeLibrary(nHandle) End If End Function ' ========= Private Property Get Py() As Variant If python_ Is Nothing Then _ Call StartServer Set Py = python_ End Property Private Function RaiseServerError() Dim sErr$: sErr = python_ Set python_ = Nothing Debug.Print sErr Call Err.Raise(1000, Description:=sErr) End Function