Как вы предотвращаете повреждение общих файлов Excel?

Question

У меня есть 10 или около того общих файлов Excel с поддержкой макросов, которые ежедневно изменяют около 30-50 пользователей. Со временем файлы увязнут и раздуты, так как пользователи думают, что пользователи все еще используют их, хотя они и не используют их. Если я не делаю и делюсь файлами иногда, они со временем становятся поврежденными.

Мой вопрос: как лучше всего это предотвратить?

Моя первоначальная идея заключалась в том, чтобы написать макрос, который распространил все файлы, а затем снова поделился ими, чтобы избавиться от мусора. Недостатком этого является то, что он выгнал бы всех текущих пользователей, поэтому я решил против этого.

Подумав некоторое время, я нашел возможное решение. Пожалуйста, оцените мой ответ и помогите мне улучшить его, или, если у вас есть лучшее решение, пожалуйста, дайте мне знать.

Answer 1

Для своего решения я создал макрос, который очищает все пользовательские представления и сравнивает, как долго пользователь был неактивен, а затем исключает их, если они превышают ограничение по времени. Я запускаю Clean_Up, когда файлы открыты.

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

Обновление: 01.09.15 Итак, прошла неделя без проблем, но я заметил, что некоторые файлы стали немного больше.

Я считаю, что это связано с тем, что он хранит историю изменений в течение 30 дней. Я уменьшил это до 1 дня, чтобы сохранить размер файла низким.

В общем списке больше нет лишних пользователей, и файлы работают отлично.

Обновление: 17.09.15 Размер файлов остается прежним, пользователи не заметили снижения производительности. Мне не нужно было делать какую-либо работу с файлами, чтобы убрать наворот. Кажется, это исправило проблемы.

Обновление: 27.03.17 Оригинальный ответ выше работал хорошо, пока мы действительно не начали толкать эти рабочие книги. Теперь около 150 пользователей вносят тысячи изменений в эти рабочие книги каждую неделю, и в этот момент у нас снова возникли проблемы.

Поэтому я добавил дополнительный код в Unshare workbooks еженедельно, а затем Reshare workbook при первом их открытии в воскресенье. Это решает любые другие проблемы, которые могут привести к повреждению книги.

Я добавил финальную часть около года назад, и так как у нас не было проблем вообще. Вот заключительная часть моего кода с комментариями, чтобы объяснить это. Просто добавьте это в модуль и вызовите подпрограмму SundayMaintenance для события Workbook_Open:

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

Обновление: 23.07.18 Я добавил небольшое изменение ухмылки в этот ответ. Мы по-прежнему выполняем этот код в наших общих рабочих книгах, и они не аварийно завершают работу и работают, как ожидалось. Мы также используем последнюю версию SharePoint, которая еще не ознакомилась с функциями общей книги.