☰

如何防止共享 Excel 文件损坏？

tag-icon • tag-icon microsoft-excel vba shared-access
如何防止共享 Excel 文件损坏？

我有大约 10 个启用了宏的共享 Excel 文件，每天大约有 30-50 个用户多次修改这些文件。随着时间的推移，文件变得臃肿不堪，因为 Excel 认为用户仍在使用它们，但实际上他们并没有使用。如果我不偶尔取消共享并重新共享这些文件，它们最终会损坏。

我的问题是防止这种情况发生的最佳方法是什么？

我最初的想法是编写一个宏，取消共享所有文件，然后重新共享它们以清除垃圾。这样做的缺点是它会踢出所有当前用户，所以我决定不这样做。

经过一段时间的思考，我想到了一个可能的解决方案。请批评我的答案并帮助我改进它，或者如果您有更好的解决方案，请告诉我。

答案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

更新：2015 年 9 月 1 日 因此，已经过去了大约一周的时间，没有任何问题，但我注意到一些文件已经开始变得有点大。

我相信这是因为它会保留 30 天的变更历史记录。我将其减少到 1 天以保持文件大小较小。

共享用户列表中不再有多余的用户，并且文件运行良好。

更新：2015 年 9 月 17 日 文件大小保持不变，用户没有注意到任何性能下降。我不需要对文件进行任何工作来清理膨胀。这似乎已经解决了问题。

更新：2017 年 3 月 27 日 上面的原始答案在我们真正开始推广这些工作簿之前一直很有效。现在我们大约有 150 名用户每周对这些工作簿进行数千次更改，这时我们又开始遇到问题了。

因此我添加了额外的代码，每周取消共享工作簿，然后在周日第一次打开时重新共享工作簿。这解决了可能导致工作簿损坏的任何其他问题。

我大约在一年前添加了最后一部分，因为我们根本没有遇到任何问题。这是我的代码的最后一部分，带有注释来解释它。只需将其添加到模块并在 Workbook_Open 事件上调用 SundayMaintenance 例程：

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

更新：2018 年 7 月 23 日 我把 smirkingman 的小改动添加到这个答案中。我们仍在共享工作簿中运行此代码，它们不会崩溃，并且按预期运行。我们还运行最新的 SharePoint 版本，它仍然没有赶上共享工作簿的功能。

相关内容