无法刷新对外部xlsm文件的引用

Question

我有两个Excel文件，父文件和子文件，其中子文件包含父函数使用的函数库。出于版本控制的目的，我将它们保存在同一个文件夹中，并在完全相同的位置复制和重命名文件夹，以跟踪我的版本。我还希望引用动态更新，这样当我移动到新版本时，父级总是指向同一位置的子级。

所以为了实现这一点，我在parent中实现了两个例程。

一，是在这个工作簿中我使用了Workbook_Open sub:

Private Sub Workbook_Open()
'Force the location of the shared library to the current project folder irrespective where the project is located
Call reloadSharedLibrary
End Sub

第二，在模块库中，我添加了另一个子重载共享库：

Public librName As Variant

Public isRefReloaded As Boolean
Sub reloadSharedLibrary()
isRefReloaded = True
Dim VBAEditor As VBIDE.VBE
Dim vbProj As VBIDE.VBProject
Dim chkRef As VBIDE.Reference
Dim BoolExists As Boolean
Dim librPath As String
Set VBAEditor = Application.VBE
Set vbProj = ActiveWorkbook.VBProject
librName = "lib_emtm"
librPath = Application.ActiveWorkbook.Path & "lib.xlsm"
' delete any shared lib (if exists)
For Each chkRef In vbProj.References
If chkRef.Name = librName Then
vbProj.References.Remove chkRef
BoolExists = True
End If
Next
' you can only add it to VBAProject only after you quit the above loop
On Error Resume Next
vbProj.References.AddFromFile librPath
If Err.Number <> 0 Then
MsgBox "FATAR ERROR: Cannot find shared library file in project root": End
End If

Set vbProj = Nothing
Set VBAEditor = Nothing
End Sub

现在，这个问题是，当我将项目文件夹复制到新版本文件夹时，对子文件夹的引用不会更新。该版本使用的子版本来自旧版本。

我做错了什么？

Answer 1

问题是，当VBA工程加载文档及其引用时，它会为它们指定一个名称，在您的情况下是lib_emtm。取消选中对它的引用时，该引用将从VBA项目中删除，但项目编辑器会将该名称保留在其缓存中。此名称将保留在缓存中，直到您关闭工作簿并重新打开它。

您可以在项目引用菜单中验证这一点：您将看到，即使取消选中引用，库lib_emtm的名称仍将显示在那里。

然后，当您尝试添加对"另一个"子工作簿(同一文件夹中的子工作簿)的引用时，编辑器会发现名称为lib_emtm，与缓存中的名称相同，因此它不会打开新文档并对其进行解析，而是使用缓存的版本，即旧版本！

如果关闭然后重新打开应用程序，库的名称将从缓存中消失，因此可以安装正确的版本。完整地说，这种模式只出现在对其他工作簿的引用中，而不出现在系统上安装的常规DLL中。

在重新安装Cached library之前，我尝试过，但找不到VBA方法将其从编辑器的缓存中删除。如果有人找到方法，它将完成解决方案。因此，目前我们必须先关闭文档，然后再重新打开它并安装lib。这个过程可能是自动化的，但我建议使用一个提示用户的解决方案。

' Module ThisWorkbook
Option Explicit
Private Sub Workbook_Open()
'Force the location of the shared library to the current project folder irrespective where the project is located
Dim check As Boolean: check = checkSharedLibrary
If check Then Exit Sub
Dim prompt
prompt = MsgBox("The installed lib_emtm library was uninstalled because it was not the correct version." & vbCrLf & _
"If you click Ok, document will close and the correct version will be automatically installed when you reopen it." & vbCrLf & _
"If you click Cancel, library will not be available in this session but will be installed next time you open the document", vbOKCancel)
If prompt = vbOK Then ThisWorkbook.Close True
End Sub
' Regular module
Option Explicit
Private librName As String, librpath As String
' if correct version already installed (correct path) return true
' if library installed with incorrect version, uninstall it and return false
' if library not installed, install it and return true
Public Function checkSharedLibrary() As Boolean
librName = "lib_emtm"
librpath = ThisWorkbook.Path & "lib_emtm.xlsm"
Dim chkRef As VBIDE.Reference
For Each chkRef In ThisWorkbook.VBProject.References
If chkRef.name = librName Then Exit For
Next
If chkRef Is Nothing Then
install_emtm
checkSharedLibrary = True
ElseIf Left(chkRef.FullPath, InStrRev(chkRef.FullPath, "") - 1) = ThisWorkbook.Path Then
checkSharedLibrary = True ' we have the correct version
Else
ThisWorkbook.VBProject.References.Remove chkRef ' return false
End If
End Function
Private Sub install_emtm()
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile(librpath)
If Err.Number <> 0 Then MsgBox "FATAR ERROR: Could not install lib_emtm:" & vbCrLf & Err.Description & vbCrLf & vbCrLf & _
"Please verify that the library's file is present in the same folder or try a manual install"
End Sub

最后一点，如果我们直接关闭应用程序，该过程可以在没有用户干预的情况下实现自动化，但在此之前，我们可以安排重新打开工作簿。但事情可能会变得复杂，因为用户可能打开了其他Excel文档，所以我们不能强迫她关闭所有内容。