Question

在VBA for excel中我使用FileSystemObject循环浏览文件夹中的文件，然后当我找到一个excel文件时，我试图打开它并更新文件中的任何超链接。

每当我尝试在excel中打开文件时，都会收到错误消息Run-time error '2147024832 (80070040)': Automation error The specified network name is no longer available.尝试打开文件失败，如果我在此事件后退回代码，我似乎不再能够“查看”文件夹对象中的文件。

例如，如果文件夹中有6个文件，而最后一个文件是excel文件，ModifyFiles函数将遍历前5个文件，看到它们不是excel文件，并移动到下一个。在最后它将正确识别excel文件并调用IsWorkBookOpen函数，如果它未打开，它会成功检查，然后继续调用UpdateLinks过程。当它点击该行打开文件时，它需要一秒钟，就像它尝试访问该文件，然后我得到上述错误消息，它无法执行打开命令。之后，如果我回到调用过程并尝试再次遍历文件，它将在For each fileX in foldX行上给出相同的错误消息。

就好像试图打开文件会破坏我与服务器的连接。

有什么建议吗？

我的代码（服务器名称和共享已更改，但我检查了它们的准确性并且它们很好）：

Option Explicit
Dim strLISTMOD()            As String
Dim strLISTFAIL()           As String

Sub Main()
    Dim blnE    As Boolean
    Dim blnA    As Boolean
    Dim blnS    As Boolean

        With Application
            blnE = .EnableEvents
            blnA = .DisplayAlerts
            blnS = .ScreenUpdating
            .EnableEvents = False
            .DisplayAlerts = False
            .ScreenUpdating = False
        End With

    ReDim strLISTMOD(0 To 0)
    ReDim strLISTFAIL(0 To 0)
    FileDigger "\\myserver\myshare\"

        With Application
            .EnableEvents = blnE
            .DisplayAlerts = blnA
            .ScreenUpdating = blnS
        End With
End Sub

Private Function IsWorkBookOpen(ByRef strFILENAME As String)
    Dim lngX                As Long
    Dim lngErr              As Long

    On Error Resume Next
    lngX = FreeFile()
    Open strFILENAME For Input Lock Read As #lngX
    Close lngX
    lngErr = Err
    On Error GoTo 0

        Select Case lngErr
            Case 0:    IsWorkBookOpen = False
            Case 70:   IsWorkBookOpen = True
            Case Else: Error lngErr
        End Select
End Function

Private Function FileDigger(strDIRECTORY As String) As String

    Dim oFsoX               As Scripting.FileSystemObject
    Dim foldX               As Scripting.Folder
    Dim foldY               As Scripting.Folder
    Dim lngErr              As Long

    Set oFsoX = New Scripting.FileSystemObject

    On Error Resume Next
    Set foldX = oFsoX.GetFolder(strDIRECTORY)
    lngErr = Err
    On Error GoTo 0

        If Not foldX Is Nothing Then
            ModifyFiles foldX
                For Each foldY In foldX.SubFolders
                    FileDigger = FileDigger(foldY.Path)
                Next
        End If

End Function

Private Sub ModifyFiles(ByRef foldDIR As Scripting.Folder)
    Dim fileX               As Scripting.File

        For Each fileX In foldDIR.Files
            If fileX.Name Like "*.xls*" Then
                    If Not IsWorkBookOpen(fileX.Path) Then
                        UpdateLinks fileX.Path
                        AddToList fileX.Name, True
                    Else
                        AddToList fileX.Name, False
                    End If
            End If
        Next
End Sub

Private Sub UpdateLinks(strPATH As String)
    Dim lnkX    As Excel.Hyperlink
    Dim wshX    As Excel.Worksheet
    Dim wbkX    As Excel.Workbook

    Set wbkX = Application.Workbooks.Open(strPATH, True, False, , , , True)
    For Each wshX In wbkX.Worksheets
       For Each lnkX In wshX.Hyperlinks
            lnkX.Address = Replace(lnkX.Address, "\\oldserver\oldshare\", "\\newserver\newshare\")
        Next lnkX
    Next
    wbkX.Close True

End Sub

Private Sub AddToList(ByRef strFILENAME As String, ByRef blnMODIFIED As Boolean)
    Dim strLIST()   As String

        If blnMODIFIED Then strLIST = strLISTMOD Else strLIST = strLISTFAIL

    If Len(strLIST(0)) > 0 Then
        ReDim Preserve strLIST(0 To UBound(strLIST) + 1)
        strLIST(UBound(strLIST)) = strFILENAME
    Else
        strLIST(0) = strFILENAME
    End If
End Sub

Answer 1

嗯，我想我已经解决了这个问题。感谢@TimWilliams - 您的原始评论确实是解决方案。我不是100％肯定问题的根本原因 - 如果有人知道并且关心解释我非常好奇学习 - 但问题似乎是我在访问之前尝试访问该文件包含FileSystemObject对象的文件夹。我不知道FSO对象是否保留每个文件夹及其子项或什么，但我发现如果我销毁FSO对象，那么我可以访问这些文件。我最终做的是修改FileDigger函数，以便在尝试打开excel中的任何文件之前构建要从根目录和所有子文件夹修改的所有文件的完整列表。我使用布尔标志来标识递归FileDigger过程的基本情况，然后我在调用ModifyFiles过程之前销毁FSO对象。

这似乎可以用于测试。我将不得不等到工作日结束才能在整个网络共享上运行它，因为当人们访问该共享上的文件时我不想创建那么多流量。

我尝试打开文件时立即收到错误“指定的网络名称不再可用”

1 个答案: