Question

我一直在使用另一个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\...而不是S:\开头。

是否要解决此问题？对于这个长期存在的问题表示歉意。

Answer 1

我将其添加为答案，因为它包含代码，并且注释有点长。
我不确定这是否是您的追求。

该代码将获取映射的驱动器并返回网络驱动器，反之亦然，对于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

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

1 个答案: