Comment empêchez-vous la corruption de fichiers Excel partagés?

J'ai 10 fichiers Excel partagés en macro, environ 30 à 50 utilisateurs modifient plusieurs fois par jour. Au fil du temps, les fichiers s'emballent et se gonflent à partir d'excellentes pensées que les utilisateurs utilisent encore, même s'ils ne le sont pas. Si je ne partage pas de partage et ne diffuse les fichiers de façon occasionnelle, ils finissent par devenir corrompus.

Ma question est de savoir quelle est la meilleure façon d'éviter cela?

Mon idée originale était d'écrire une macro qui ne partageait pas tous les fichiers, puis les a ré-partagés pour se débarrasser de la jonque. L'inconvénient à cela est que cela risquerait de chasser tous les utilisateurs actuels, alors je me suis opposé à cela.

Après avoir réfléchi pendant un certain temps, j'ai trouvé une solution possible. S'il vous plaît critiquez ma réponse et aidez-moi à améliorer ou si vous avez une meilleure solution, faites-le moi savoir.

Pour ma solution, j'ai fait une macro qui efface toutes les vues personnalisées et compare combien de temps un utilisateur a été inactif et les déclenche si elles sont dépassées. Je lance Clean_Up lorsque les fichiers sont ouverts.

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 = 1 To UBound(Users) 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 

Mise à jour: 9/1/15 Donc il a été une semaine ou moins, sans aucun problème, j'ai remarqué cependant que certains des fichiers ont commencé à augmenter un peu.

Je crois que cela est dû à cela en gardant un historique des changements pendant 30 jours. Je l'ai réduit à 1 jour pour réduire la taille du fichier.

Il n'y a plus d'utilisateurs supplémentaires dans la liste des utilisateurs partagés et les fichiers fonctionnent bien.

Mise à jour: 9/17/15 Les fichiers restent de la même taille que les utilisateurs n'ont noté aucune baisse de performance. Je n'ai pas eu à faire de travail sur les fichiers pour nettoyer les ballots. Cela semble avoir résolu les problèmes.

Mise à jour: 3/27/17 La réponse initiale ci-dessus a fonctionné bien jusqu'à ce que nous avons vraiment commencé à pousser ces classeurs. Nous avons maintenant environ 150 utilisateurs qui font des milliers de modifications à ces classeurs chaque semaine, c'est à ce moment-là, nous avons commencé à avoir des problèmes à nouveau.

J'ai donc ajouté un code supplémentaire pour non partager les classeurs par semaine, puis resachetez le classeur la première fois qu'ils sont ouverts dimanche. Cela prend en charge tout autre problème pouvant entraîner la corruption du classeur.

J'ai ajouté la partie finale il y a environ un an et, puisque nous n'avons eu aucun problème. Voici la partie finale de mon code avec des commentaires pour l'expliquer. Ajoutez-le simplement à un module et appelez la routine SundayMaintenance sur 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 = 1 To UBound(Users) 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