In VBA for excel I'm using the FileSystemObject to loop through the files in a folder, then when I find an excel file I'm trying to open it and update any hyperlinks in the file.
Whenever I try to open a file in excel, I receive the error message Run-time error '2147024832 (80070040)': Automation error The specified network name is no longer available. The attempt to open the file fails, and if I step back through the code after this event, I no longer seem to be able to "see" the files in the folder object.
For example, if there are 6 files in a folder, and the last one is an excel file, the ModifyFiles function will loop through the first 5 files, see that they aren't excel files, and move to the next. On the last it will properly recognize the excel file and call the IsWorkBookOpen function,if it is not open, it succeeds in checking and then it proceeds to call the UpdateLinks procedure. When it hits the line to open the file, it takes a second like it's trying access the file, then I get the aforementioned error message and it fails to execute the open command. After that, if I go back to the calling procedure and try to loop through the files again, it will give me the same error message on the For each fileX in foldX line.
It's as if trying to open the file is breaking my connection to the server.
Any suggestions?
My code (server names and shares have been changed, but I checked them for accuracy and they are good):
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
Well, I think I have this solved. Thanks to @TimWilliams - your original comment really was the solution. I'm not 100% sure on the root cause of the problem - which if anyone knows and cares to explain I'm extremely curious to learn - but the problem seems to be that I was trying to access the file before I was done accessing the folder with the FileSystemObject object. I don't know if the FSO object reserves each folder and it's children or what, but I found if I destroy the FSO object then I could access the files. What I ended up doing was modifying the FileDigger function so that I am constructing the entire list of all the files to modify from the root directory and all subfolders BEFORE I try to open any file in excel. I used a Boolean flag to identify the base case of the recursive FileDigger procedure and then I just destroy the FSO object before calling the ModifyFiles procedure.
This seems to work in testing. I'll have to wait until the workday is over to run it on the entire network share as I don't want to create that much traffic while people are accessing files on that share.