如何在 VBA 中使用唯一标识符引用 Excel 链接

Question

如何在 VBA 中使用打开文件时不会更改的唯一标识符来引用外部工作簿？当包含完整文件路径并且没有打开同名文件时，它可以正常工作。但是，当打开文件时，带有文件路径的完整表单不起作用，单独的文件名也不起作用。

我想创建一个更新 Sub 来更新所有引用，如果电子表格打开，这会自行搞砸（请参阅下面的第 2 点）。

以下是我认为应该可行的一些原因：

1. 在手动链接更新菜单中似乎只有文件名可以参考；
2. 也无法打开两个同名的工作簿，因此如果您打开源链接，则单元格引用会从文件路径更改为文件名（这正是导致问题的原因。

这是我目前拥有的代码 updCellRef 是对文件路径的单元格引用（我只想使用文件名）：

    Sub updateValues(updCellRef)
        updFilePath = ActiveWorkbook.Sheets("INPUTS").Range(updCellRef).Value
        ActiveWorkbook.updateLink Name:=updFilePath, Type:=xlExcelLinks
    End Sub

为了澄清这个问题，当我使用上述函数更新值时，当源电子表格打开时，它仅由其文件名引用。当它关闭时，它会被其完整的文件路径引用。

我正在使用 Excel Professional 2010 v14 和 VBA v7.0

注意：我不想使用任何其他软件，包括 Power Query，因为没有管理员权限就无法安装。

Answer 1

这是引用链接的另一种方式。

Dim linkName As String, fileName As String, i As Integer

For Each link In ActiveWorkbook.LinkSources
    On Error GoTo tryName
    ActiveWorkbook.UpdateLink linkName

    If False Then
  tryName:
        i = InStrRev(linkName, "\") ' 0 if no "\" found
        If i > 0 Then
            On Error Resume Next ' to ignore error if fileName does not work too
            fileName = Mid(linkName, i + 1)
            ActiveWorkbook.UpdateLink fileName 
        End If
    End If
    On Error GoTo 0 ' reset the error handling        
Next

但是link 和以前一样是文件路径的字符串

更新

您能否发布数据的屏幕截图 > 编辑链接以使其更清晰一点？

在我的测试中，前 3 个链接很好，但最后一个有问题。

Answer 2

有两种方法可以将信息添加到文件名以使其唯一，或者在 Excel 中打开文件，在该文件中可以看到没有打开的文件共享相同的名称，或者包含整个路径。因此，除非它们是打开的，否则您不能“​​仅使用文件名引用 VBA 中的外部工作簿”，因为这样会不确定您所引用的所有文件中的哪个共享相同的名称。

这里是 MS Office 支持的消息来源说"When the source is not open, the external reference includes the entire path"

更新：鉴于原始问题的 cmets，我想我们在这里：

1. 我们对打开的文件和指向它们的任何链接感到满意，因为它们已经打开，因此应该已经更新
2. 我们有一个文件列表，如果我们可以通过给定路径找到它们，并且如果没有打开另一个具有相同文件名的文件没有，我们希望强制更新这些文件

现在试试这个：

 Sub updateValues(updFilepath As String)
    If Not FileInUse(updFilepath) Then
        ActiveWorkbook.UpdateLink Name:=updFilepath, Type:=xlExcelLinks
    'else workbook is open and Excel have automatically updated linke
    End If
End Sub

Public Function FileInUse(sFileName As String) As Boolean
On Error Resume Next
Open sFileName For Binary Access Read Lock Read As #1
Close #1
FileInUse = IIf(Err.Number > 0, True, False)
On Error GoTo 0 
End Function

The file test function 由用户 2267971 提供，回复 this question also on how to test if a file is open

Answer 3

你可以试试下面的方法

1. 测试链接是否来自打开的工作簿
2. 如果使用过，则使用ChangeLink 欺骗 Excel 进行更新
3. 如果没有，请运行适用于已合书的现有代码。

代码

 Sub updateValues()
 Dim updFilePath As String
 Dim Wb As Workbook
 Dim bFound As Boolean

 updFilePath = ActiveWorkbook.Sheets("INPUTS").Range(updCellRef).Value

 For Each Wb In Application.Workbooks
 If Wb.FullName = updFilePath Then
    ActiveWorkbook.ChangeLink Wb.Name, Wb.Name
    bfound = True
    Exit For
 End If
 Next

 If Not bfound Then ActiveWorkbook.UpdateLink Name:=updFilePath, Type:=xlExcelLinks
End Sub

Answer 4

我可以想到您在这里可能遇到的两种情况：

1.根据标题，我可以猜到问题在于，您尝试引用的工作簿位于父工作簿的子文件夹中；如果是这样，我注意到即使您提供完整路径，它也会工作一段时间，然后它会错过引导它的路径 - 似乎这是一个错误（虽然我不知道是什么触发了它）-。链接仅适用于 excel 界面，但是，当您尝试使用 vba 中的超链接时，它会给出错误，因为完整路径已被切断，这会导致路径不完整 - 因此要验证它，它说不再有效 - .我没有其他解决方案可以在发生这种情况时再次向用户询问路径（对依赖于此的所有进程使用主单元以使其更容易修复/解决方法）。这可以解决它以便通过 VBA 检索它。只需确保单元格值在请求时具有工作簿的全名-

    Sub Test()
    Dim HLToTest As String
        HLToTest = RetriveWBLink(Range("B2").Value)
    End Sub
    Function RetriveWBLink(WBName As String) As String
    Dim FileSystemLibrary As Object: Set FileSystemLibrary = CreateObject("Scripting.FileSystemObject")
        On Error GoTo Err01RetriveWBLink
        RetriveWBLink = FileSystemLibrary.GetFile(ThisWorkbook.Path & "\" & WBName)
        If 1 = 2 Then '99. If error
Err01RetriveWBLink:
        'this may happen for new workbooks that aren't saved yet
        RetriveWBLink = "False"
        End If '99. If error
        On Error GoTo -1
        Set FileSystemLibrary = Nothing
    End Function

2.如果 (1) 不是这种情况，这应该通过检索给定 WB 的完整路径来解决它（这只是要更新链接，不管它是否已经打开）

Sub Test()
Dim HLToTest As String
    HLToTest = RetriveWBLink(ThisWorkbook)
End Sub
Function RetriveWBLink(WBName As Workbook) As String
Dim FileSystemLibrary As New Scripting.FileSystemObject
    On Error GoTo Err01RetriveWBLink
    RetriveWBLink = FileSystemLibrary.GetFile(WBName.Path & "\" & WBName.Name)
    If 1 = 2 Then '99. If error
Err01RetriveWBLink:
    'this may happen for new workbooks that aren't saved yet
    RetriveWBLink = "False"
    End If '99. If error
    On Error GoTo -1
    Set FileSystemLibrary = Nothing
End Function

Answer 5

我并不是说这是唯一的方法，但我能想到的最简单的方法是使用以下方式实际打开工作簿：

Dim wb as Workbook
Set wb = Excel.Workbooks.Open(Filename)

updFilePath = wb.Sheets("INPUTS").Range(updCellRef).Value
wb.Close

我理解您的意思，如果电子表格与您打开的电子表格同名，它会呕吐。也许一个简单的技巧是捕获活动工作簿的文件名，将其保存为临时文件，然后在最后将其保存回来。我确实说过这是一个 hack。

我知道您可以通过 C# 或 MS Access 使用 ADO 访问像数据库一样的电子表格数据，所以我猜也可以直接从 Excel 执行此操作。也就是说，这似乎不像上面的建议那么简单。我认为 ADO 即使处理单个单元格也必须读取整个电子表格，所以我认为这无论如何都不会为您节省任何东西。