How do you prevent corruption of shared Excel files?
I have 10 or so Shared Macro Enabled Excel files that about 30-50 users modify multiple times each day. Over time the files get bogged down and bloated from excel thinking users are still using them even though they are not. If I do not unshare and reshare the files occasionally they eventually become corrupt.
My question is what is the best way to prevent this?
My original idea was to write a macro that un-shared all of the files and then re-shared them to get rid of the junk. The down side to this is that it would kick all current users out so I decided against that.
After thinking about it for awhile I came up with a possible solution. Please critique my answer and help me improve upon it or if you have a better solution please let me know.
Solution 1:
For my solution I made a macro that clears all the custom views and compares how long a user has been inactive and then kicks them out if they are over the time limit. I run Clean_Up when the files are opened.
Sub Clean_Up()
'Clean up Extra Data to prevent file from being sluggish
Dim cv As CustomView
For Each cv In ActiveWorkbook.CustomViews
cv.Delete
Next cv
SharedUserCheck
End Sub
Sub SharedUserCheck()
'Remove old users to speed up shared workbook
Dim TimeStart As Date
Dim TimeLimit As Date
Dim SharedDuration As Date
Dim Users As Variant
Dim UserCount As Integer
'Set time limit here in "HH:MM:SS"
TimeLimit = TimeValue("02:00:00")
Users = ActiveWorkbook.UserStatus
For UserCount = UBound(Users) To 1 Step -1
TimeStart = Users(UserCount, 2)
SharedDuration = Now - TimeStart
If SharedDuration > TimeLimit Then
'MsgBox (Users(UserCount, 1) & " has been inactive for " & Application.Text(SharedDuration, "[hh]:mm") & " and will now be removed from the workbook.")
ThisWorkbook.RemoveUser (UserCount)
End If
Next
End Sub
Update: 9/1/15 So it has been a week or so without any problems I have noticed however that some of the files have started to get a little bigger.
I believe this is due to it keeping a change history for 30 days. I reduced this to 1 day to keep file size low.
There are no extra users any longer in the shared user list and the files are functioning great.
Update: 9/17/15 The files are remaining the same size the users have not noticed any performance declines. I have not had to do any work on the files to clean up bloat. This seems to have fixed the problems.
Update: 3/27/17 The original answer above worked well until we really started to push these workbooks. We now have about 150 users making thousands of changes to these workbooks every week it was at this point we started to have issues again.
So I added additional code to Unshare the workbooks weekly and then Reshare the workbook the first time they are opened on Sunday. This takes care of any other issues that might cause the workbook to become corrupt.
I added the final part about a year ago and since we have not had issues at all. Here is the final part of my code with comments to explain it. Just add this to a module and call the SundayMaintenance routine on the Workbook_Open Event:
Public Sub RemoveOtherUsers()
'Remove all other users to prevent access violation
Dim Users As Variant
Dim UserCount As Integer
Users = ThisWorkbook.UserStatus
For UserCount = UBound(Users) To 1 Step -1
If Users(UserCount, 1) <> Application.UserName Then
ThisWorkbook.RemoveUser (UserCount)
End If
Next
End Sub
Public Sub SundayMaintenance()
Application.ScreenUpdating = False
'On every Sunday the first time the sheet is opened clear out extra data and extra sheets
If (WeekdayName(Weekday(Date)) = "Sunday") And (Sheets(1).Cells(3, "AG").Value < Date) Then
'Disconnect other users as a precaution
RemoveOtherUsers
Application.DisplayAlerts = False
'Unshare to clear extra data out
ThisWorkbook.UnprotectSharing ("Whatever Password")
Application.DisplayAlerts = True
'Set Change History to 1 day to prevent build up of junk in the file
With ThisWorkbook
If .KeepChangeHistory Then
.ChangeHistoryDuration = 1
End If
End With
'Store Last Date Unshared and Cleared to prevent multiple unshare events on sunday.
Sheets(1).Cells(3, "AG").Value = Date
'Delete all extra sheets that were added by mistake and have the word sheet in them
For Each WS In ThisWorkbook.Worksheets
If UCase(WS.Name) Like "Sheet" & "*" Then
Application.DisplayAlerts = False
WS.Delete
Application.DisplayAlerts = True
End If
Next
'Reshare
Application.DisplayAlerts = False
ThisWorkbook.ProtectSharing Filename:=ThisWorkbook.FullName, SharingPassword:="Whatever Password"
Application.DisplayAlerts = True
End If
Application.ScreenUpdating = True
End Sub
Update: 7/23/18 I added smirkingman's small change to this answer. We are still running this code in our shared workbooks and they do not crash and are running as expected. We also run the latest SharePoint version which has still not caught up with the features of a shared workbook.