私は10個ほどの共有マクロ対応Excelファイルを持っており、約30〜50人のユーザーが毎日複数回変更しています。時間の経過とともに、ファイルは、ユーザーが使用していない場合でも使用していると考えて、Excelから行き詰まり、肥大化します。ファイルの共有を解除したり再共有したりしないと、最終的にファイルが破損することがあります。
私の質問は、これを防ぐための最良の方法は何ですか?
私の当初のアイデアは、すべてのファイルの共有を解除し、それらを再共有してジャンクを取り除くマクロを作成することでした。これの欠点は、現在のすべてのユーザーを追い出すことになるので、私はそれに反対することにしました。
しばらく考えた後、私は可能な解決策を思いついた。私の答えを批評して、それを改善するのを手伝ってください。または、より良い解決策があれば、私に知らせてください。
私のソリューションでは、すべてのカスタムビューをクリアし、ユーザーが非アクティブであった時間を比較し、制限時間を超えている場合はそれらを追い出すマクロを作成しました。ファイルを開いたときに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
更新:9/1/15 1週間ほど経ちましたが、問題なく、一部のファイルが少し大きくなり始めていることに気づきました。
これは、変更履歴を30日間保持しているためだと思います。ファイルサイズを低く抑えるために、これを1日に短縮しました。
共有ユーザーリストに余分なユーザーはもう存在せず、ファイルは正常に機能しています。
更新:9/17/15ファイルは同じサイズのままであり、ユーザーはパフォーマンスの低下に気づいていません。膨張をクリーンアップするためにファイルに対して何もする必要はありませんでした。これで問題は解決したようです。
更新:3/27/17上記の元の回答は、これらのワークブックを実際にプッシュし始めるまではうまく機能しました。現在、約150人のユーザーが毎週これらのワークブックに数千の変更を加えています。この時点で再び問題が発生し始めました。
そこで、毎週ワークブックを共有解除し、日曜日に初めて開いたときにワークブックを再共有するようにコードを追加しました。これにより、ブックが破損する可能性のあるその他の問題が処理されます。
約1年前に最後の部分を追加しましたが、まったく問題がなかったので。これが私のコードの最後の部分であり、それを説明するコメントが付いています。これをモジュールに追加し、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
更新:7/23/18この回答にsmirkingmanの小さな変更を追加しました。共有ワークブックでこのコードを実行していますが、クラッシュせず、期待どおりに実行されています。また、共有ブックの機能にまだ追いついていない最新のSharePointバージョンも実行しています。