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 to execute and I see a flash of a workbook being added to the list of projects in the VBA project window - but it immediately closes (is removed from the projects tree) and the code actually steps back to the previous line (which is in the calling procedure). If I continue to step through, when it gets to that line again and tries to execute it that's when I get the network name is no longer available error message. From there, if I step back through the code and try to access and files/folders using the `FileSystemObject` I get one of two error messages `the network name is no longer available` or `permission denied`.
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):
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 to execute and I see a flash of a workbook being added to the list of projects in the VBA project window - but it immediately closes (is removed from the projects tree) and the code actually steps back to the previous line (which is in the calling procedure). If I continue to step through, when it gets to that line again and tries to execute it that's when I get the network name is no longer available error message. From there, if I step back through the code and try to access and files/folders using the `FileSystemObject` I get one of two error messages `the network name is no longer available` or `permission denied`.
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):
Code:
Option Explicit
Dim strLISTMOD() As String
Dim strLISTINUSE() 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 strLISTINUSE(0 To 0)
FileDigger "\\lokts64\engshare\"
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 lngErr > 0 Then
Err.Raise lngErr
lngErr = 0
End If
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
Dim lngX As Long
For Each fileX In foldDIR.Files
If fileX.Name Like "*.xls*" Then
If Not IsWorkBookOpen(fileX.Path) Then
AddToList fileX.Path, True
Else
AddToList fileX.Path, False
End If
End If
Next
For lngX = 0 To UBound(strLISTMOD)
If Len(strLISTMOD(lngX)) > 0 Then UpdateLinks strLISTMOD(lngX)
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 = Excel.Application.Workbooks.Open(strPATH, 3, False, , , , True, , , , False, , False, True, xlNormalLoad)
For Each wshX In wbkX.Worksheets
For Each lnkX In wshX.Hyperlinks
lnkX.Address = Replace(lnkX.Address, "\\lokad\eng\share\", "\\lokts\engshare\")
Next lnkX
Next
wbkX.Close True
End Sub
Private Sub AddToList(ByRef strFILENAME As String, ByRef blnMODLIST As Boolean)
Dim strLIST() As String
If blnMODLIST Then strLIST = strLISTMOD Else strLIST = strLISTINUSE
If Len(strLIST(0)) > 0 Then
ReDim Preserve strLIST(0 To UBound(strLIST) + 1)
strLIST(UBound(strLIST)) = strFILENAME
Else
strLIST(0) = strFILENAME
End If
If blnMODLIST Then strLISTMOD = strLIST Else strLISTINUSE = strLIST
End Sub
