时间戳

首页 > 解决方案 > 使用函数打开和更新外部工作簿中的值，但返回源错误

excel - 使用函数打开和更新外部工作簿中的值，但返回源错误

问题描述

我一直在使用另一个 StackOverflow 问题中的函数（很抱歉，我找不到原始答案！）来帮助遍历 L 列中的许多单元格，其中包含一个公式，该公式会吐出我们的超链接文件路径。这意味着打开每个（工作簿），更新值，然后在打开下一个之前保存并关闭工作簿。见下文。

Sub List_UpdateAndSave()
    Dim lr As Long
    Dim i As Integer
    Dim WBSsource As Workbook
    Dim FileNames As Variant
    Dim msg As String
    ' Update the individual credit models
    With ThisWorkbook.Sheets("List")
        lr = .Cells(.Rows.Count, "L").End(xlUp).Row
        FileNames = .Range("L2:L" & lr).Value
    End With
    For i = LBound(FileNames, 1) To UBound(FileNames, 1)
        On Error Resume Next
        If FileNames(i, 1) Like "*.xls*" Then
            Set WBSsource = Workbooks.Open(FileNames(i, 1), _
                                           ReadOnly:=False, _
                                           Password:="", _
                                           UpdateLinks:=3)
            If Err = 0 Then
                With WBSsource
                    'do stuff here
                    .Save
                    .Close True
                End With
            Else
                msg = msg & FileNames(i, 1) & Chr(10)
                On Error GoTo 0
            End If
        End If

        Set WBSsource = Nothing
    Next i
    If Len(msg) > 0 Then
        MsgBox "The Following Files Could Not Be Opened" & _
               Chr(10) & msg, 48, "Error"
    End If
End Sub

现在的问题是我正在使用它在网络驱动器上工作，因此它会导致连接/编辑链接部分的路径问题。每个文件都存储在S:\...其中，由于使用超链接公式，将无法找到源数据。请参阅下面的示例图像，该文件是通过我的原始工作簿中的超链接单元格打开的。当我去更新它的编辑链接部分时，它会显示这些错误。

如果我在 Windows 资源管理器中打开该字母驱动器并找到该文件，则它可以正常工作。打开，更新值>保存>关闭，它说未知...

（但如果我在此处单击更新值，它们会正确更新。）

如果在单元格中使用超链接公式打开（也指向S:\..），则表示它包含无法更新的链接。我选择编辑链接，它们都是“错误：找不到源”。它们上的位置也以\\\corp\...and not开头S:\。

有任何解决这个问题的方法吗？为冗长的问题道歉。

标签： excelvbaexcel-formulaexcel-2010

解决方案

我将此添加为答案，因为它包含代码并且评论有点长。
我不确定这是否是你所追求的。

该代码将获取映射的驱动器并返回网络驱动器，或者 Excel 文件反之亦然。 DriveMap是包含最终字符串的变量 - 您可能希望适应一个函数。 

Sub UpdatePath()

    Dim oFSO As Object
    Dim oDrv As Object
    Dim FileName As String
    Dim DriveMap As String

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    FileName = Range("A1")

    If InStr(oFSO.GetExtensionName(FileName), "xls") > 0 Then

        For Each oDrv In oFSO.drives
            If oDrv.sharename <> "" Then
                'Changes \\corp\.... to S:\
                If InStr(FileName, oDrv.sharename) = 1 Then
                    DriveMap = Replace(FileName, oDrv.sharename, oDrv.Path)
                End If

                'Changes S:\ to \\corp\....
'                If InStr(FileName, oDrv.Path) = 1 Then
'                    DriveMap = Replace(FileName, oDrv.Path, oDrv.sharename)
'                End If

            End If
        Next oDrv

    End If

End Sub

推荐阅读