Lire et modifier les propriétés des fichiers Office [Fait]

[SilkyRoad]

bonjour


quelques exemples pour lire et modifier les propriétés des fichiers Office



Lire les propriétés d'un classeur par builtinDocumentProperties

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Sub infosClasseurBuiltinDocumentProperties()
Dim Valeur As DocumentProperty
Dim R As Byte
 
On Error Resume Next
R = 1
For Each Valeur In ActiveWorkbook.BuiltinDocumentProperties
    Cells(R, 1) = Valeur.Name
    Cells(R, 2) = Valeur.Value
    R = R + 1
Next
End Sub

Modifier le nom de l'auteur dans les propriétés du classeur , en utilisant BuiltinDocumentProperties

Code :

ThisWorkbook.BuiltinDocumentProperties("Author").Value = "xld"

Ajouter une propriété personnalisée dans le classeur actif

Code :

1
2
3
4
5
6
7
8
9
10
11
Sub ajouterProprietePersonnalisee()
ActiveWorkbook.CustomDocumentProperties.Add Name:="infoX", _
Type:=msoPropertyTypeNumber, LinkToContent:=False, Value:=1965
'Les types de données possibles :
'msoPropertyTypeNumber:Valeurs entieres
   '(si vous insérez 196.4 , c'est 196 qui sera enregistré )
'msoPropertyTypeFloat:Valeurs numériques
'msoPropertyTypeBoolean: Vrai ou Faux
'msoPropertyTypeDate: Dates et heures
'msoPropertyTypeString :Texte
End Sub

Boucler sur toutes les propriétés personnalisées du classeur actif

Code :

1
2
3
4
5
6
7
8
9
Sub bouclerSurToutesLesProprietesPersonnalisees()
Dim Cp As DocumentProperty
 
If ActiveWorkbook.CustomDocumentProperties.Count = 0 Then Exit Sub
 
For Each Cp In ActiveWorkbook.CustomDocumentProperties
    MsgBox Cp.Name & vbLf & Cp.Value
Next Cp
End Sub

Lire une propriété personnalisée spécifique

Code :

MsgBox ActiveWorkbook.CustomDocumentProperties("infoX").Value

Modfifier une propriété personnalisee

Code :

ActiveWorkbook.CustomDocumentProperties("infoX").Value = 1997

Supprimer une propriété personnalisée

Code :

ActiveWorkbook.CustomDocumentProperties("infoX").Delete

Afficher les propriétés de tous les fichiers d'un répertoire, sans les ouvrir

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub proprietesFichiers()
'source:
' http://www.microsoft.com/resources/documentation/windows/2000/server/
'scriptguide/en-us/sas_fil_lunl.mspx
'
'Necessite d'activer la reference Microsoft Shell Controls and Automation
'
Dim objShell As Object, strFileName As Object
Dim objFolder As Folder
Dim Resultat As String
Dim i As Byte
 
Set objShell = CreateObject("Shell.Application")
'repertoire cible
Set objFolder = objShell.nameSpace("C:\Documents and Settings\michel\dossier")
 
'boucle sur tous les elements du repertoire
For Each strFileName In objFolder.Items
    'pour que les sous dosssiers ne soient pas pris en comptes
    If strFileName.isFolder = False Then
    Resultat = ""
        For i = 0 To 34
        Resultat = Resultat & objFolder.getDetailsOf(strFileName, i) & vbLf
        Next
    MsgBox Resultat
    End If
Next
End Sub

Lire quelques propriétés d'un classeur sans l'ouvrir : utilisation de GetFile

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub proprietesClasseur()
Dim Cible As Object, Valeur As Object
Dim Resultat As String, Fichier As String
 
Fichier = "C:\Classeur2.xls" 'adpater le chemin
Set Cible = createObject("Scripting.fileSystemObject")
Set Valeur = Cible.getFile(Fichier)
 
Resultat = "Chemin : " & Valeur.parentFolder & Chr(10) & Chr(10) & _
"Nom et chemin fichier : " & Fichier & Chr(10) & Chr(10) & _
"Date creation : " & Valeur.dateCreated & Chr(10) & Chr(10) & _
"Derniere modification : " & Valeur.dateLastModified & Chr(10) & Chr(10) & _
"Taille classeur : " & Valeur.Size & " octets"
 
Msgbox Resultat
End Sub

Afficher toutes les propriétés d'un classeur sans l'ouvrir

La procédure utilise la librairie DSO oleDocument Properties Reader 2.0
Si elle n'est pas installée sur ton poste , vous pouvez la télécharger sur le site Microsoft :

http://support.microsoft.com/default...;EN-US;Q224351

Remarque :
Cette librairie fonctionne pour tous les documents Office ( Excel, Word , Powerpoint …)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub lireProprietesClasseur()
'necessite d'activer la reference DSO OleDocument Properties Reader 2.0
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351
Dim DSO As DSOFile.OleDocumentProperties
 
Set DSO = New DSOFile.OleDocumentProperties
 
'le fichier doit etre fermé !
DSO.Open sfilename:="C:\Documents and Settings\michel\dossier\leClasseur.xls"
MsgBox DSO.SummaryProperties.Author & vbLf & DSO.SummaryProperties.Comments
'
'Les autres propriétés:
'
'ApplicationName 'Author 'ByteCount 'Category 'CharacterCount 
'CharacterCountWithSpaces'Comments 'Company 'DateCreated 
'DateLastPrinted 'DateLastSaved 'HiddenSlideCount
'Keywords 'LastSavedBy 'LineCount 'Manager 'MultimediaClipCount 
'NoteCount 'PageCount 'ParagraphCount 'PresentationFormat 
'RevisionNumber 'SharedDocument 'SlideCount
'Subject 'Template 'Title 'TotalEditTime 'Version 'WordCount
'
DSO.Close
End Sub

Modifier les propriétés d'un classeur sans l'ouvrir

Exemple pour modifier le champ "commentaire" d'un fichier

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub modifierProprietesClasseur()
'necessite d'activer la reference DSO OleDocument Properties Reader 2.0
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351
Dim DSO As DSOFile.OleDocumentProperties
 
Set DSO = New DSOFile.OleDocumentProperties
 
'le fichier doit etre fermé !
DSO.Open sfilename:="C:\Documents and Settings\michel\monFichier.xls"
DSO.SummaryProperties.Comments = "mon nouveau commentaire"
DSO.Save
DSO.Close
End Sub

Ajouter une propriété personnalisée au classeur sans ouvrir le fichier

La procédure utilise aussi la librairie DSO oleDocument Properties Reader 2.0 et fonctionne pour les autres types de documents Office

Code :

1
2
3
4
5
6
7
8
9
10
11
Sub AjouterProprietesPersonnalisees()
Dim DSO As DSOFile.OleDocumentProperties
 
Set DSO = New DSOFile.OleDocumentProperties
 
'le fichier doit etre fermé !
DSO.Open sfilename:="C:\Documents and Settings\michel\monfichier.xls"
DSO.CustomProperties.Add "maPropriete", "Bonjour"
DSO.Save
DSO.Close
End Sub

Lire une propriété personnalisée sans ouvrir le fichier

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub LireProprietesPersonnalisees()
'necessite d'activer la reference DSO OleDocument Properties Reader 2.0
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q224351
Dim DSO As DSOFile.OleDocumentProperties
 
Set DSO = New DSOFile.OleDocumentProperties
 
'le fichier doit etre fermé !
DSO.Open sfilename:="C:\Documents and Settings\michel\dossier\monClasseur.xls"
MsgBox DSO.CustomProperties.Item("LeNomDeMaProprietePersonnalisee").Value
'ou ( l'index de la 1ere propriete personnalisée est 0 )
'MsgBox DSO.CustomProperties.Item(0).Value
DSO.Close
End Sub

Passer un classeur en lecture seule , sans l'ouvrir

Code :

1
2
3
4
5
6
7
8
9
Sub passerClasseur_lectureSeule()
'necessite d'activer la reference Microsoft Scriping Runtime
Dim Fs As FileSystemObject
Dim F As File
 
Set Fs = CreateObject("Scripting.FileSystemObject")
Set F = Fs.GetFile("C:\classeur1.xls")
F.Attributes = F.Attributes + ReadOnly
End Sub

La fonction FileDateTime

Renvoie la date et l'heure de création ou de dernière modification d'un fichier

Code :

MsgBox FileDateTime("C:\monClasseur.xls")

bonne soiree
michel

[SilkyRoad]

bonsoir

pour info, j'ai complèté les exemples sur cette page

http://silkyroad.developpez.com/VBA/...etesClasseurs/


bonne soirée
michel

[ThierryAIM]

On publie comme tuto ou comme Q/R FAQ ?

[SilkyRoad]

Q/R FAQ ...;o)

[ThierryAIM]

Une entrée FAQ pour la prochaine MAJ et annonce du tutoriel

sujet clos, Merci