我在这里遇到了一个小问题，需要你们的帮助。
我有一个通过 COM 互操作公开的 C# DLL。它工作正常，但显然 C# 互操作对象的部署是一场灾难，每次更新 DLL 时都需要重新充气。
所以我想知道如何使用这个 C# DLL 中的函数，如下所示： 或者我可以通过将 DLL 和电子表格放在一起来调用函数的任何内容。
Declare Function getString Lib "<PATH of my DLL>" () as string
sub test()
range("A1").value = getString
End Sub
语法可能有误。
【问题讨论】：
您可以这样做，但您必须了解 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
【讨论】：
这些是放在类顶部的 using 语句，它们是关键：
使用 System.Diagnostics； 使用 RGiesecke.DllExport;
还要确保在安装上述模板的 Nuget PM 语句之前已经启动了一个项目。我对此很陌生-我相信还有其他人。我正在使用 AutoCAD VBA，但由于它是 64 位，因此出现了另一个错误 - 我必须在 Declare 语句中使用 PtrSafe （等）才能使 VBA 继续没有错误（请参阅 MS 文档以获取此 http://support.microsoft.com/kb/983043）
顺便说一句！
我的最终代码（基于以上）
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
【讨论】：
我多次遇到这个问题。 我最终使用 shell 和等待方法从 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
希望对你有帮助:)
【讨论】：