Using a C# dll inside EXCEL VBA

后端 未结 3 1170
深忆病人
深忆病人 2020-12-05 01:13

I am running into a little problem here and need you guys\' help.

I have a C# DLL exposed through COM interop. It is working alright, but apparently the deployment o

相关标签:
3条回答
  • 2020-12-05 01:50

    You can do that, but you have to be aware of the differences of VBA and .Net.
    First, you have to create an actual DLL (.Net assemblies are not), to do that, use this project template. Then again, you have to be aware of how to marshal stuff.
    VBA only supports stdcall as calling convention and it can't really deal with Unicode for DLL functions. This isn't bad per se, as the default marshaling for String in .Net is what VBA is expecting (a pointer to an Ansi char). Also, stdcall is the default calling convention that I use for exports.

    I'll reuse a sample I've create recently for another SO thread:

    Put this in a project you created using my template:

    [ComVisible(true), ClassInterface(ClassInterfaceType.AutoDual)]
    public class Sample
    {
       public string Text
       {
          [return: MarshalAs(UnmanagedType.BStr)]
          get;
          [param: MarshalAs(UnmanagedType.BStr)]
          set;
       }
    
       [return: MarshalAs(UnmanagedType.BStr)]
       public string TestMethod()
       {
          return Text + "...";
       }
    }
    
    static class UnmanagedExports
    {
       [DllExport]
       [return: MarshalAs(UnmanagedType.IDispatch)]
       static Object CreateDotNetObject(String text)
       {
          return new Sample { Text = text };
       }
    }
    

    This is how to call it from VBA:

    Declare Function CreateDotNetObject Lib "The full path to your assembly or just the assembly if it is accessible from Excel" _
      (ByVal text As String) As Object
    
    Sub test()
    
      Dim instance As Object
    
      Set instance = CreateDotNetObject("Test 1")
      Debug.Print instance.Text
    
      Debug.Print instance.TestMethod
    
      instance.text = "abc 123" ' case insensitivity in VBA works as expected'
    
      Debug.Print instance.Text
    End Sub
    
    0 讨论(0)
  • 2020-12-05 01:51

    These are the using statements to put at the top of your class which are key:

    using System.Diagnostics; using RGiesecke.DllExport;

    Also ensure that you have a project started before the Nuget PM statement to install the template above. I am new at this - I am sure there are others as well. I am using AutoCAD VBA and got another error since it is 64 bit - I had to use PtrSafe (etc) in the Declare statement for VBA to continue without errors (see MS docs for this http://support.microsoft.com/kb/983043)

    It worked btw!

    My final code (based on the above)

    using System;
    using System.Collections.Generic;
    using System.Linq;
    using System.Text;
    using System.Runtime.InteropServices;
    using System.Diagnostics;
    using RGiesecke.DllExport;
    
    namespace ClassLibrary3
    {
        [ComVisible(true), ClassInterface(ClassInterfaceType.AutoDual)]
        public class Class1
        {
            public string Text
            {
                [return: MarshalAs(UnmanagedType.BStr)]
                get;
                [param: MarshalAs(UnmanagedType.BStr)]
                set;
            }
    
            [return: MarshalAs(UnmanagedType.BStr)]
            public string TestMethod()
            {
                return Text + "...";
            }
        }
    
        static class UnmanagedExports
        {
            [DllExport]
            [return: MarshalAs(UnmanagedType.IDispatch)]
            static Object CreateDotNetObject(String text)
            {
                return new Class1 { Text = text };
            }
        }
    }
    

    and my vba code:

    #If VBA7 Then
        Private Declare PtrSafe Function CreateDotNetObject Lib "G:\gitRepository\VS\ClassLibrary3\ClassLibrary3\bin\Debug\ClassLibrary3.dll" (ByVal text As String) As Object
    #Else
        Private Declare Function CreateDotNetObject Lib "G:\gitRepository\VS\ClassLibrary3\ClassLibrary3\bin\Debug\ClassLibrary3.dll" (ByVal text As String) As Object
    #End If
    
    Sub test()
    
      Dim instance As Object
    
      Set instance = CreateDotNetObject("Test 1")
      Debug.Print instance.text
    
      Debug.Print instance.TestMethod
    
      instance.text = "abc 123" ' case insensitivity in VBA works as expected'
    
      Debug.Print instance.text
    End Sub
    
    0 讨论(0)
  • 2020-12-05 02:00

    i had this issue many times. i ended up registering the com dll from vba using a shell and wait method, on the regasm util to register/unregister the dll before late bound creating the com object via

     CreateObject('yourclasshere')
    

    Its a bit of a hack but it works, heres the shellandwait method and a register and unregister method that follows.

                 Private Declare Function OpenProcess Lib "kernel32" _
                 (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
                 ByVal dwProcessId As Long) As Long
    
                 Private Declare Function GetExitCodeProcess Lib "kernel32" _
                 (ByVal hProcess As Long, lpExitCode As Long) As Long
    
                 Private Const STATUS_PENDING = &H103&
                 Private Const PROCESS_QUERY_INFORMATION = &H400
    
    
                 Private Function ShellandWait(ExeFullPath As String, _
                 Optional TimeOutValue As Long = 0) As Boolean
    
                     Dim lInst As Long
                     Dim lStart As Long
                     Dim lTimeToQuit As Long
                     Dim sExeName As String
                     Dim lProcessId As Long
                     Dim lExitCode As Long
                     Dim bPastMidnight As Boolean
    
                     On Error GoTo ErrorHandler
    
                    lStart = CLng(Timer)
                     sExeName = ExeFullPath
    
                     'Deal with timeout being reset at Midnight
                     If TimeOutValue > 0 Then
                         If lStart + TimeOutValue < 86400 Then
                             lTimeToQuit = lStart + TimeOutValue
                         Else
                             lTimeToQuit = (lStart - 86400) + TimeOutValue
                             bPastMidnight = True
                         End If
                     End If
    
                     lInst = Shell(sExeName, vbHide)
    
                 lProcessId = OpenProcess(PROCESS_QUERY_INFORMATION, False, lInst)
    
                    Do
                         Call GetExitCodeProcess(lProcessId, lExitCode)
                         DoEvents
                         If TimeOutValue And Timer > lTimeToQuit Then
                             If bPastMidnight Then
                                  If Timer < lStart Then Exit Do
                             Else
                                  Exit Do
                             End If
                     End If
                     Loop While lExitCode = STATUS_PENDING
    
                   ShellandWait = True
                   Exit Function
    
                 ErrorHandler:
                 ShellandWait = False
    
                 End Function
    
    
          Private Function RegisterPayload() As Boolean
    
              Dim script As String
              script = "cmd /c"
              script = script + " " + "%windir%\Microsoft.NET\Framework\v2.0.50727\regasm"
              script = script + " " + Chr(34) + InstallationPath + Chr(34)
              script = script + " /codebase"
    
              RegisterPayload = ShellandWait(script)
    
          End Function
    
          Private Function UnRegisterPayload() As Boolean
              Dim script As String
              script = "cmd /c"
              script = script + " " + "%windir%\Microsoft.NET\Framework\v2.0.50727\regasm"
              script = script + " " + Chr(34) + InstallationPath + Chr(34)
              script = script + " /u"
    
              UnRegisterPayload = ShellandWait(script)
          End Function
    

    Hope it helps :)

    0 讨论(0)
提交回复
热议问题