Changer date de création (datecreated) d'un fichier excel

Commenter

Contenu du snippet

Vous mettez à jour des macros dans un fichier Excel en réseau
Ce fichier doit pouvoir être récupéré automatiquement chez tous les utilisateurs, par comparaison de la date de création.
1°)Vous devrez donc changer la date de création du fichier réseau après l'avoir modifié, grâce au fichier MajSource. xls dans unrépertoire annexe
2°)il sera également nécessaire de changer la date de création du fichier recopié sur chaque poste, par la même astuce.
3°)Dans ces conditions, une comparaison des dates de création source/utilisateur pourra déclencher la mise à jour automatique du fichier utilisateur

Source / Exemple : 


'Exemple
'sur le réseau on a les 2 Répertoires : 
' => CheminSource & Source.xls : fichier source.xls (date à changer...)
' => CheminTemp & MajSource.xls : fichier MajSource.xls (rep de travail)
'sur les postes utilisateurs on a les 2 fichiers :
' => CheminUser & Source.xls
' => CheminUser & MajUser.xls : fichier MajUser.xls (rep de travail)
'***************************************************************
'Au Réseau : Dans le CLASSEUR DE TRAVAIL (MajSource.xls)
'***************************************************************
'dans ThisWorkbook
Private Sub Workbook_Open()
Application.ScreenUpdating = False  'masque les écrans intermédiaires
SourceMaJ                           'lance la mise à jour de la date de création initiale
ThisWorkbook.Save
i = Workbooks.Count                 'comptage des classeurs ouverts (autres applications Excel en cours)
If i < 2 Then                       'si c'est la seule application Excel ouverte
   Application.Quit                 'quitte l'application (ferme Excel)
Else                                's'il y a d'autres fichiers Excel ouverts,
  ActiveWorkbook.Close              'ferme seulement le fichier (sans fermer les autres)
End If
End Sub
'***************************************************************
'dans un module
Sub SourceMaJ()                     'Change la date de création initiale
Application.ScreenUpdating = False  'masque les écrans intermédiaires
Dim fs, f1, f2
Dim FF As Integer
Dim strNewFile As String
Dim strTempFile As String
FilePath1 = "\\CheminSource\"       'chemin réseau de la source
FilePath2 = "\\CheminTemp\"         'chemin réseau du répertoire de travail
Filename = "Source.xls"             'nom du fichier source
Set fs = CreateObject("Scripting.FileSystemObject")
'copie de la source dans le répertoire d'échange (même nom)
fs.CopyFile FilePath1 & Filename, FilePath2 & Filename 
On Error Resume Next
strNewFile = FilePath1 & Filename           'chemin source nouvelle date
SetAttr strNewFile, vbNormal                'si traitement en mode caché 
strTempFile = FilePath1 & "Temp" & Filename 'Chemin source temporaire
SetAttr strTempFile, vbNormal               'si traitement en mode caché 
strOldFile = FilePath2 & Filename           'Chemin source ancienne date
SetAttr strOldFile, vbNormal                'si traitement en mode caché 
'supprime la Source ancienne date dans Chemin Source
If Dir(strNewFile) <> "" Then Kill (strNewFile)
'Création fichier source temporaire vide
FF = FreeFile()                             
Open strTempFile For Output As #FF          'ouvre à valeur 0 octets 
Close #FF                                   'et ferme la source copiée
'recopie la Source (vide) avec nouvelle date sur chemin Source
FileCopy strTempFile, strNewFile
'supprime la source temporaire vide
Kill strTempFile
'***************************************************************
'écrase la source vide nouvelle date par la source ancienne date
'=> Cette opération de change PAS la date de création !
'***************************************************************
Set f1 = fs.GetFile("\\CheminTemp\Source.xls")
Set f2 = fs.GetFile("\\CheminSource\Source.xls")
fs.CopyFile f1, f2, True
SetAttr f2, vbHidden                        'si traitement en mode caché
Kill (f1)                                   'supprime la source ancienne date
End Sub
'***************************************************************

'A ce niveau, le fichier Source recoit une nouvelle date de création (date et heure du traitement par MajSource.xls)
'Il est alors possible de comparer avec les dates de création des Source Utilisateurs

'***************************************************************
'Sur le Poste Utilisateur : Dans le CLASSEUR SOURCE (Source.xls)
'***************************************************************
'dans Thisworkbook
Private Sub Workbook_Open()
Dim fs, f1, f2, f3, s1, s2
FilePath1 = "\\CheminSource\" 'chemin réseau de la source
FilePath2 = "CheminUser\" 'chemin de la source sur le Poste User
FilePath3 = "CheminUser\" 'chemin du répertoire de travail User
FilenameS = "Source.xls"
FilenameU = "MajUser.xls
Set fs = CreateObject("Scripting.FileSystemObject")
'Reprend la date de création du fichier Source réseau
Set f1 = fs.GetFile(FilePath1 & FilenameS)
s1 = f1.DateCreated
'Reprend la date de création du fichier Source Utilisateur
Set f2 = fs.GetFile(FilePath2 & FilenameS)
s2 = f2.DateCreated
'si la date Source User est trop ancienne, Start User est mis à jour par le classeur MajUser.xls
If s1 > s2 Then 
   Workbooks.Open(FilePath3 & FilenameU)
   Workbooks(FilenameS).close savechanges:=false
End if
End sub
'***************************************************************
'Sur le Poste Utilisateur : Dans le CLASSEUR MajUser (MajUser.xls)
'***************************************************************
Private Sub Workbook_Open()
FilePath1 = "\\CheminSource\" 'chemin réseau de la source
FilePath2 = "CheminUser\" 'chemin de la source sur le Poste User
FilePath3 = "CheminUser\" 'chemin du répertoire de travail User
FilenameS = "Source.xls"
Dim f1, f2
f1 = FilePath1 & FilenameS
f2 = FilePath2 & FilenameS
copy f1,f2, true
ThisWorkbook.Save
i = Workbooks.Count                 'comptage des classeurs ouverts (autres applications Excel en cours)
If i < 2 Then                       'si c'est la seule application Excel ouverte
   Application.Quit                 'quitte l'application (ferme Excel)
Else                                's'il y a d'autres fichiers Excel ouverts,
  ActiveWorkbook.Close              'ferme seulement le fichier (sans fermer les autres)
End If

Conclusion :


Il y a certes d'autre procédés (d'ailleurs tout aussi lourds), mais on reste intégralement en VBA, et seuls 2 petits fichiers sont nécessaires. Attention toutefois, que si à l'ouverture de Source.xls vous appelez une fentêre modale, évidemment sa fermeture par macro en l'état va planter...
Personnellement, j'utilise ce procédé pour appeler un fichier maître Excel très lourd par les fichiers Source de chaque utilisateurs (que je peux ainsi mettre à jour). Ils leur renvoient les noms et coordonnées d'un autre utilisateur déja connecté au fichier maître, ce qui permet d'éviter de le partager, car ni Excel ni surtout les utlisateurs n'aiment ça! Ce fera l'objet peut-être d'une autre source...

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (CerberusPau)