Question

我在这里遇到一个小问题，需要你帮助。

我有一个通过COM互操作公开的C＃DLL。它工作正常，但显然C＃interop对象的部署是一场灾难，每次更新DLL时都需要重新计算。

所以我想知道如何使用这个C＃DLL中的函数，如下所示：或者我可以通过将DLL和电子表格放在一起来调用函数。

Declare Function getString Lib "<PATH of my DLL>" () as string

sub test()
   range("A1").value = getString
End Sub

语法可能有误。

Answer 1

你可以这样做，但你必须意识到VBA和.Net的区别首先，您必须创建一个实际的DLL（.Net程序集不是），为此，使用this project template。然后，你必须知道如何编组东西 VBA仅支持stdcall作为调用约定，它不能真正处理DLL函数的Unicode。这本身并不错，因为.Net中String的默认封送是VBA所期望的（指向Ansi char的指针）。此外，stdcall是我用于导出的默认调用约定。

我将重用我最近为另一个SO线程创建的示例：

将它放在您使用我的模板创建的项目中：

[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 };
   }
}

这是从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

Answer 2

这些是使用语句放在类的顶部，这是关键：

使用System.Diagnostics; 使用RGiesecke.DllExport;

还要确保在Nuget PM语句之前启动项目以安装上述模板。我是新手 - 我相信还有其他人。我正在使用AutoCAD VBA并且因为它是64位而得到了另一个错误 - 我必须在声明语句中使用PtrSafe（etc）来继续VBA（没有错误的MS文档）

它工作顺便！

我的最终代码（基于以上内容）

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 };
        }
    }
}

和我的vba代码：

#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

Answer 3

我有很多次这个问题。我最后使用shell和wait方法从vba注册com dll，在regasm util上注册/取消注册dll，然后通过

创建com对象。

 CreateObject('yourclasshere')

它有点像黑客但是它有效，继承了shellandwait方法以及随后的注册和取消注册方法。

             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

希望有所帮助：）

在EXCEL VBA中使用C＃dll

3 个答案: