Load a custom DLL programmatically from another path

[yinkajewole]

I have a DLL with I don't want to put it in the system folder.
I do I let VBA, how do I load dll from the path I want?

 

[Jaafar Tribak]

I have a DLL with I don't want to put it in the system folder.
I do I let VBA, how do I load dll from the path I want?

Is that an ActiveX dll or a standard windows dll ?
Do you access the dll through the API declarations like the way you access windows dlls ?

 

[yinkajewole]

Is that an ActiveX dll or a standard windows dll ?
Do you access the dll through the API declarations like the way you access windows dlls ?

I access the dll through the API declarations like this

[/COLOR]Declare Function GetVersion Lib "MyDLL" () As Integer

 

[Jaafar Tribak]

I access the dll through the API declarations like this

Declare Function GetVersion Lib "MyDLL" () As Integer

Then you could pass the full path as follows :

Declare Function GetVersion Lib "[B]YOUR_DLL_PATH_HERE\[/B]MyDll.dll" () As Integer

 

[yinkajewole]

Then you could pass the full path as follows :

Declare Function GetVersion Lib "[B]YOUR_DLL_PATH_HERE\[/B]MyDll.dll" () As Integer

I know much about doing it this way. but the problem with this is that if i move the file to another computer, the path won't work anymore.
so, i don't know if it's possible to put the dll in the same path of the workbook and make reference to it in vba to that anywhere i copy the file and the dll to, there won't be path failure?

 

[Jaafar Tribak]

https://docs.microsoft.com/en-us/windows/desktop/dlls/dynamic-link-library-search-order

1- According to the MS documentation ,the standard dll search order used by the system always includes the current directory therefore you could try, for example, placing your dll file in the workbook path and temporarly change the current Dir via code before calling the dll function as follows:

Declare Function GetVersion Lib "MyDLL" () As Integer

Function CallGetVersion() As Integer

    Dim sDir As String
    
    sDir = CurDir
    ChDir ThisWorkbook.Path
    CallGetVersion = GetVersion
    ChDir sDir

End Function


Sub Test()

    Dim iRet As Integer
    
    iRet = CallGetVersion
    MsgBox iRet

End Sub

2- Alternatively, you could palce the dll file in the workbook directory just as above but load the dll dynamically using the Loadlibrary API... something like this :

Option Explicit

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
    Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long
    Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
    Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
    Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
    Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If


Function CallGetVersion(ByVal Dll_Path As String) As Integer

    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
        Dim hLib As LongPtr, hProcAddr As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Dim hLib As Long, hProcAddr As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

    hLib = LoadLibrary(Dll_Path)
    hProcAddr = GetProcAddress(hLib, "GetVersion")
    If hProcAddr Then
        CallGetVersion = CallWindowProc(hProcAddr, 0, 0, 0, 0)
    End If
    FreeLibrary hLib

End Function


Sub Test()

    Dim iRet As Integer
    
    iRet = CallGetVersion(ThisWorkbook.Path & "\MyDll.dll")
    MsgBox iRet

End Sub

The second method would need to be tweaked depending on the type and number of args of your dll function.

 

[yinkajewole]

Thanks. I used the first method

 

[Jaafar Tribak]

Thanks. I used the first method

You are welcome.

I would still test the code on a different machine before distributing the workbook and dll just to double-check that the code works

 

[Tragic Shadow]

The second method would need to be tweaked depending on the type and number of args of your dll function.

I would like to request how to tweak the second method if there were 5 arguments to pass to the function inside the DLL like:

CallGetVersion = CallWindowProc(hProcAddr, 0, 0, 0, 0, 0)

(to mods: I don't think I need to start a new thread as I wanted to extend possible answers to the main question by OP. If that's not the case, I'd happily start a new thread.)

 

[Jaafar Tribak]

I would like to request how to tweak the second method if there were 5 arguments to pass to the function inside the DLL like:

CallGetVersion = CallWindowProc(hProcAddr, 0, 0, 0, 0, 0)

The oleaut32 library exports this little used but extremely useful api function called DispCallFunc... With this function, one can call other functions (apis or otherwise) which have more than 4 arguments.

Here is a generic helper function DllStdCall that wraps the above ole api:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As LongPtr, ByVal FuncAddr As LongPtr, ByVal CallConvention As Integer, ByVal rtnType As VbVarType, ByVal FuncArgsCnt As Long, ByRef FuncArgTypes As Any, ByRef FuncArgVarAddresses As Any, ByRef FuncResult As Any) As Long
    Private Declare PtrSafe Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare PtrSafe Function MessageBoxExW Lib "user32" (ByVal hwnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal uType As Long, ByVal wLanguageId As Long) As Long
    Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
    Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
    Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long
#Else
    Private Declare Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As Long, ByVal FuncAddr As Long, ByVal CallConvention As Integer, ByVal rtnType As VbVarType, ByVal FuncArgsCnt As Long, ByRef FuncArgTypes As Any, ByRef FuncArgVarAddresses As Any, ByRef FuncResult As Any) As Long
    Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
    Private Declare Function MessageBoxExW Lib "user32" (ByVal hwnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal uType As Long, ByVal wLanguageId As Long) As Long
    Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
    Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
#End If

#If Win64 Then
    Private Function DllStdCall(ByVal pAddr As LongLong, ByVal FunctionReturnType As Long, ParamArray FunctionParameters() As Variant) As Variant
 
        Dim vParamPtr() As LongLong
#Else
    Private Function DllStdCall(ByVal pAddr As Long, ByVal FunctionReturnType As Long, ParamArray FunctionParameters() As Variant) As Variant
 
        Dim vParamPtr() As Long
#End If

    Const CC_STDCALL    As Long = 4
 
    If Not (FunctionReturnType And &HFFFF0000) = 0& Then Exit Function

    Dim pIndex As Long, pCount As Long
    Dim vParamType() As Integer
    Dim vRtn As Variant, vParams() As Variant

    vParams() = FunctionParameters()
    pCount = Abs(UBound(vParams) - LBound(vParams) + 1&)
    If pCount = 0& Then
        ReDim vParamPtr(0 To 0)
        ReDim vParamType(0 To 0)
    Else
        ReDim vParamPtr(0 To pCount - 1&)
        ReDim vParamType(0 To pCount - 1&)
        For pIndex = 0& To pCount - 1&
            vParamPtr(pIndex) = VarPtr(vParams(pIndex))
            vParamType(pIndex) = VarType(vParams(pIndex))
        Next
    End If
 
    pIndex = DispCallFunc(ByVal 0&, pAddr, CC_STDCALL, FunctionReturnType, pCount, vParamType(0), vParamPtr(0), vRtn)
    If pIndex = 0& Then
        DllStdCall = vRtn
    Else
        SetLastError pIndex
    End If

End Function

And here is an example that shows how to use the DllStdCall wrapper in order to dynamically call an api function with more than 4 arguments.

In this test, I have chosen the MessageBoxExW api which is exported by the User32 Windows library and which has 5 arguments but you can choose any other api function in the same fashion.

Sub Test()

    #If Win64 Then
        Dim hLib As LongLong, hProcAddr As LongLong
    #Else
        Dim hLib As Long, hProcAddr As Long
    #End If
   
    Const MB_ICONINFORMATION = &H40&
   
    hLib = LoadLibrary("user32")
    If hLib Then
        hProcAddr = GetProcAddress(hLib, "MessageBoxExW")
        If hProcAddr Then
            DllStdCall hProcAddr, vbLong, Application.hwnd, StrPtr("Hello World!"), StrPtr("Tile"), MB_ICONINFORMATION, 0
        End If
    End If
    Call FreeLibrary(hLib)

End Sub

EDIT:
You need to make sure you pass the correct expected types for the arguments and for the function return , failing to do so can crash the application.