Программно установить путь поиска DLL в макросе VBA

Question

Проблема

• У меня есть шаблон слова, который использует оператор VBA Declare для ссылки на DLL, путь которого можно определить в макросе VBA
• Я хочу выполнить развертывание в каталоге пользователей% APPDATA% \ Microsoft \ Word \ STARTUP
• Я не хочу постоянно изменять переменную окружения PATH пользователя (временно будет нормально, но, похоже, это не сработает, поскольку они не обновляются до перезапуска приложения)

Попытка решения

Я попытался динамически добавить код с операторами Declare, используя ThisDocument.VBProject.CodeModule.AddFromString(code), который работает при загрузке шаблона из обычного каталога, но когда шаблон находится в Word \ STARTUP, выдает следующую ошибку:

Ошибка времени выполнения '50289':

Невозможно выполнить операцию с проект защищен.

И установка ключа реестра "HKEY ___ LOCAL_MACHINE \ Software \ Microsoft \ Office \ 11.0 \ Word \ Security \ AccessVBOM" на 1 не исправляет это, если шаблон находится в Word \ STARTUP

---

Я действительно изо всех сил пытаюсь найти решение. Если кто-нибудь знает способ сделать это, это было бы здорово.

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

Вы можете использовать API LoadLibrary.

Например, в моих проектах код выглядит так:

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, но очевидно, что вы можете получить местоположение из диапазона в электронной таблице. Следующий фрагмент кода может быть полезным.

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'. Фрагмент показывает, как вы можете переименовать модуль кода, чтобы вы могли удалить его позже, если это необходимо. Очевидно, это просто удаляет его сразу после его создания, и вы, вероятно, не захотите этого делать, но, по крайней мере, оно покажет вам, как это будет сделано.

Сказав все это, мы в основном просто пишем .exe и выкладываем. Если вам нужно, чтобы VBA дождался завершения оболочки, для этой проблемы также есть решения.

Answer 4

Вот что я в итоге сделал, используя методологию Pranav Wagh, связанную выше, и код с сайта Си Пирсона (http://www.cpearson.com/excel/vbe.aspx).). Этот код предлагает пользователю выбрать путь к DLL, используя окно Open File, строит новый Модуль с объявленной функцией с введенным путем и функцией для выполнения рукопожатия с 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 через окно Open File, чтобы указать Excel на dll, даже если в части Lib оператора Statementre Function только имя файла.

Chris