I'm just adjusting the target, as our IT team has changed the directory mapping. I just hope I can do this without the data refreshing at the moment to cut down on time.
Code:
Sub directorychange()
Dim FileSystem As Object, HostFolder As String
HostFolder = "S:\"
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)
End Sub
Sub DoFolder(Folder)
Dim SubFolder, wb As Workbook
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
For Each File In Folder.files
If InStr(1, File.Name, ".xl") <> 0 And InStr(1, File.Name, ".lnk") = 0 And (GetAttr(File.Path) And vbReadOnly) <> 1 Then
Application.Workbooks.Open File.Path
Set wb = Workbooks(File.Name)
With wb
If .Connections.Count <> 0 Then
For Each conn In .Connections
If conn.Type = 2 Then
conn.ODBCConnection.Connection = Replace(conn.ODBCConnection.Connection, "S:\Shared\", "S:\")
conn.ODBCConnection.CommandText = Replace(conn.ODBCConnection.CommandText, "S:\Shared\", "S:\")
End If
Next conn
wb.Save
End If
End With
wb.Close
Set wb = Nothing
ElseIf InStr(1, File.Name, ".xl") <> 0 And InStr(1, File.Name, ".lnk") = 0 And (GetAttr(File.Path) And vbReadOnly) = 1 Then
End If
Next
On Error GoTo 0
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub