4

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

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

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

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

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

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

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

我正在使用带有 VBA v7.0 的 Excel Professional 2010 v14

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

4

5 回答 5

2

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

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 个链接很好，但最后一个有问题。

于 2016-08-16T12:26:11.143 回答
1

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

这是 MS Office 支持的来源，说“当源未打开时，外部引用包括整个路径”

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

  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

文件测试功能由 user2267971 提供，还回​​答了关于如何测试文件是否打开的问题

于 2016-08-15T09:50:22.030 回答
1

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


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
于 2016-08-15T13:56:26.303 回答
1

你可以试试下面的东西

  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
于 2016-08-16T09:10:52.957 回答
-1

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

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

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

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

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

于 2016-08-12T03:29:04.970 回答