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.