以编程方式在 VBA 宏中设置 DLL 搜索路径

Question

问题

• 我有一个 word 模板，它使用 VBA 的 Declare 语句链接到一个 dll，其路径可以在 VBA 宏中确定
• 我想将此部署到用户的 %APPDATA%\Microsoft\Word\STARTUP 目录
• 我不想永久更改用户的 PATH 环境变量（暂时可以，但这似乎不起作用，因为它们在应用程序重新启动之前不会被刷新）

尝试的解决方案

我尝试使用ThisDocument.VBProject.CodeModule.AddFromString(code) 动态添加带有Declare 语句的代码，这在从普通目录加载模板时有效，但是当模板位于 Word\STARTUP 中时，会出现以下错误：

运行时错误“50289”：

无法执行操作，因为 项目受到保护。

当模板位于 Word\STARTUP 中时，将注册表项“HKEY___LOCAL_MACHINE\Software\Microsoft\Office\11.0\Word\Security\AccessVBOM”设置为 1 并不能解决此问题

---

我真的很难找到解决方案。如果有人知道这样做的方法，那就太好了。

Answer 1

坦率地说，我不知道使用所有这些 VBA 代码注入、LoadLibrary() 调用的程序集生成以及我见过的用于这个简单任务的技术有什么问题。在我的项目中，我使用简单的代码从与工作簿相同的位置加载 dll，如下所示：

Declare Function MyFunc Lib "MyDll.dll" (....) As ...

Sub Test()
  ....
  ChDir ActiveWorkbook.Path
  ... = MyFunc(....)
End Sub

至少在 Excel 2003 中，从当前路径加载 dll 没有问题，将 ChDir 设置为 DLL 具有的任何路径。您可能还需要更改与当前路径分开的当前驱动器。您只需在第一次函数调用之前执行一次，之后无论您当前的路径在哪里，DLL 都会保持连接状态，因此您可以在 workbook_open 中执行一次，以后无需担心路径。为此，我在 DLL 中提供了一个空的虚拟函数。我不认为 MS Word 在这方面有什么不同。

Private Declare Sub Dummy Lib "MyDLL.dll" ()

Private Sub Workbook_Open()
    ChDrive Left$(Me.Path, 1)
    ChDir Me.Path
    Dummy
End Sub

Answer 2

您可以使用 LoadLibrary api。

例如在我的项目中，代码如下所示：

If LibraryLoaded() Then
   Call MyFunc ...
End If


Public Function LibraryLoaded() As Boolean

 Static IsLoaded As Boolean
 Static TriedToLoadAlready As Boolean

 If TriedToLoadAlready Then
    LibraryLoaded = IsLoaded
    Exit Function
  End If
  Dim path As String
 path = VBAProject.ThisWorkbook.path
 path = Left(path, InStrRev(path, "\") - 1)
 IsLoaded = LoadLibrary(path & "\bin\" & cLibraryName)
 TriedToLoadAlready = True

 LibraryLoaded = IsLoaded

End Function

Answer 3

还有一个非常非常难看的解决方案，但是这位博主想通了，我想不出任何其他方法：

http://blogs.msdn.com/pranavwagh/archive/2006/08/30/How-To-Load-Win32-dlls-Dynamically-In-VBA.aspx

基本上，您编写一个在运行时在 VBA 中创建代码模块的过程。此模块必须创建对 dll 的引用，并且必须创建一个虚拟函数（或过程）作为调用 dll 的此模块的一部分。然后，从您的代码中，您使用 Application.Run(dummyfunction(), arg1, arg2...)。这是必要的，否则项目将无法编译，因为 dummyfunction 还不是函数。

您会在他的代码中注意到，他使用 InputBox() 来获取 .dll 的位置，但显然您可以从电子表格中的某个范围内获取位置。下面的代码 sn -p 可能有用。

Dim cm As CodeModule
Dim vbc As VBComponent

Set cm = Application.VBE.ActiveVBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule
cm.AddFromString (decString & funcString)
cm.Name = "MyNewModule"
Set vbc = cm.Parent
Application.VBE.ActiveVBProject.VBComponents.Remove vbc

'decString' 和 'funcString' 只是我像他的 'ss' 一样构造的字符串。 sn-p 显示了如何重命名代码模块，以便以后可以在需要时将其删除。显然，这只是在创建后立即删除它，您可能不想这样做，但至少它向您展示了它是如何完成的。

说了这么多，我们现在大多只是编写 .exe 并进行脱壳。如果您需要 VBA 等待 shell 完成，也有针对该问题的解决方案。

Answer 4

这就是我最终做的事情，使用上面链接的 Pranav Wagh 的方法和来自 C Pearson 网站 (http://www.cpearson.com/excel/vbe.aspx) 的代码。此代码提示用户使用“打开文件”窗口选择 dll 的路径，使用输入路径的 Declare Function 和与 dll 执行握手的函数构建一个新模块。如果成功，dll 中的专用函数返回 1：

Public rtn As Integer

Sub LinkToDll()

Dim path As String, default As String
MsgBox "Select Geo_DLL.dll file from next window"

With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = False
    .Title = "Select Geo_DLL.dll file"
    If .Show = True Then
        path = .SelectedItems(1)
    End If
End With

'Add a module
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent

Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = "LinkModule"

'Add procedure to module
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long

Set VBComp = VBProj.VBComponents("LinkModule")
Set CodeMod = VBComp.CodeModule

With CodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, "Declare Function RegDll Lib " & Chr(34) & path & Chr(34) & " (ByRef rtn As Integer)"
LineNum = LineNum + 1
.InsertLines LineNum, "Sub runthisfunc(rtn)"
LineNum = LineNum + 1
.InsertLines LineNum, "On Error Resume Next"
LineNum = LineNum + 1
.InsertLines LineNum, "rtn = 0"
LineNum = LineNum + 1
.InsertLines LineNum, "RegDll rtn"
LineNum = LineNum + 1
.InsertLines LineNum, "If rtn = 1 Then MsgBox (" & Chr(34) & "DLL linked" & Chr(34) & ")"
LineNum = LineNum + 1
.InsertLines LineNum, "If rtn = 0 Then MsgBox (" & Chr(34) & "DLL not found" & Chr(34) & ")"
LineNum = LineNum + 1
.InsertLines LineNum, "End Sub"
End With

'This is what CodeMod.InsertLines is writing:
'--------------------------------------------
'Declare Function RegDll Lib "C:\path\Geo_DLL.dll" (ByRef rtn As Integer)
'Sub runthisfunc(rtn)
'On Error Resume Next
'rtn = 0
'RegDll rtn
'If rtn = 1 Then MsgBox ("DLL Linked")
'If rtn = 0 Then MsgBox (DLL not found")
'End Sub

Application.Run "runthisfunc", rtn

'Delete Module
VBProj.VBComponents.Remove VBComp

End Sub

但是，一旦我将工作簿 (xlsm) 转换为插件 (xlam)，我发现 Excel 不会让宏创建新模块，因此我的 LinkToDll 将无法工作。修复方法是将 Declare 函数放回 LinkToDll，仅将 dll 文件名（“Geo_DLL.dll”）作为 Lib 以及 runthisfunc 子。我发现让用户只需通过“打开文件”窗口选择 dll 文件就足以将 Excel 指向 dll，即使在 Declare Function 语句的 Lib 部分中只有文件名。

克里斯