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

Programmatically set DLL search path in VBA macro

提问by Steve Ridout

The problem

问题

• I have a word template which uses VBA's Declarestatement to link to a dll, whose path can be determined within the VBA macro
• I want to delploy this to the users %APPDATA%\Microsoft\Word\STARTUP directory
• I DON'T want to permanently change the user's PATH environment variable (temporarily would be OK, but this doesn't seem to work as they don't get refreshed until application restart)

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

Attempted solution

尝试的解决方案

I tried dynamically adding the code with the Declarestatements using ThisDocument.VBProject.CodeModule.AddFromString(code)which works when loading the template from a normal directory, but when the template is within Word\STARTUP, it gives the following error:

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

Run-time error '50289':

Can't perform operation since the project is protected.

运行时错误“50289”：

由于项目受保护，无法执行操作。

And setting the registry key "HKEY___LOCAL_MACHINE\Software\Microsoft\Office\11.0\Word\Security\AccessVBOM" to 1 doesn't fix this when the template is in Word\STARTUP

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

---

---

I'm really struggling to find a solution. If anyone knows a way to do this, that would be great.

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

回答by panda-34

Frankly, I don't know what's the problem with using all those VBA code injection, assembly generation for LoadLibrary() calls, etc techniques that I've seen used for this simple task. In my project I use simple code to load dll from the same location as the workbook, like this:

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

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

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

Excel 2003 at least, has no problem loading the dll from the current path, Set ChDir to whatever path your DLL has. You might also need to change your current drive which is separate from current path. You have to do it only once, before the first function call, after it the DLL stays attached no matter where your current path is, so you may do it once in workbook_open and not bother about the path later. I provide an empty dummy function in the DLL just for this pupose. I don't think MS Word is any different on this.

至少 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

回答by SparcU

You can use LoadLibrary api.

您可以使用 LoadLibrary api。

For example in my projects the code looks like this:

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

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

回答by oob

There is another really really ugly solution, but this blogger figured it out, and I can't figure out any other way:

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

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

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

Basically, you write a procedure that creates a code module in VBA during runtime. This module must create a reference to the dll and it must create a dummy function (or procedure) as part of this module that calls the dll. Then, from your code, you use Application.Run(dummyfunction(), arg1, arg2...). This is necessary because otherwise, the project will not compile because dummyfunction isn't yet a function.

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

You'll notice in his code, he uses InputBox() to get the location of the .dll but obviously you could get the location from a range in the spreadsheet. The following code snippet may be useful.

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

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' and 'funcString' were just strings I constructed like his 'ss'. The snippet shows how you can rename the code module so that you could delete it later if needed. Obviously, this just deletes it right after it is created, and you probably wouldn't want to do that, but at least it shows you how it would be done.

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

Having said all that, we mostly just write .exe's now and shell out. If you need VBA to wait on the shell to finish, there are solutions for that issue as well.

话虽如此，我们现在大多只是编写 .exe 并进行外壳处理。如果您需要 VBA 等待 shell 完成，也有针对该问题的解决方案。

回答by Chris Iriarte

Here's what I ended up doing, using Pranav Wagh's methodology linked above and code from C Pearson's site (http://www.cpearson.com/excel/vbe.aspx). This code prompts the user to select the path to the dll using an Open File window, builds a new module with a Declare Function with the inputted path and a function to execute a handshake with the dll. The purpose-built function in the dll returns a 1 if successful:

这是我最终做的事情，使用上面链接的 Pranav Wagh 的方法和来自 C Pearson 网站 ( http://www.cpearson.com/excel/vbe.aspx) 的代码。此代码提示用户使用“打开文件”窗口选择 dll 的路径，使用输入路径的声明函数构建新模块，以及与 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

However, once I turned the workbook (xlsm) into an addin (xlam) I found that Excel wouldn't let the macro create new modules so my LinkToDll wouldn't work. The fix was to put the Declare Function back into LinkToDll with just the dll file name ("Geo_DLL.dll") as the Lib along with the runthisfunc sub. I found having the user simply select the dll file via the Open File window was enough to point Excel to the dll even with only the file name in the Lib portion of the Declare Function statement.

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

Chris

克里斯