Comment, en vba, obtenir les propriétés avancées d'un docume
Dadoo57 -
Bonjour,
Quelqu'un saurait comment, en vba, obtenir les propriétés avancées d'un document .docx fermé ?
CreateObject("Scripting.fileSystemObject") ou CreateObject("Shell.Application") permet d'obtenir certaines propriétés standard, mais pas toutes les propriétés (par exemple le nom du Modèle .dotm utilisé pour la création du document) que l'on trouve dans l'onglet Détails de la fenêtre Propriétés d'un fichier (c-à-d : clic droit sur le fichier, puis Propriétés, puis l'onglet Détails).
Cordialement,
David
3 réponses
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 588
bonjour,
as-tu essayé ainsi?
https://learn.microsoft.com/fr-ch/office/vba/api/word.document.builtindocumentproperties
-
-
En fait, j'ai trouvé une solution. A la création de chaque document, je crée un mot-clé avec "ActiveDocument.BuiltInDocumentProperties("Keywords").Value = ..." que je peux ensuite récupérer lorsque le document est fermé.
Merci pour ta collaboration !
Bonne Journée,
David
-
Comment récupères-tu cette valeur sans ouvrir le document?
J'ai les 2 fonctions suivantes :
Public Function M2_GetKeywordPropertyValue_4ClosedDoc(ByVal sFile As String, ByVal keyOfProp As String) As String
Dim oDic As Object
Dim k As Variant
Dim i As Integer
Dim chaine As String
Dim valeurs() As String
Dim paire() As String
Set oDic = M2_GetFileProperties(sFile)
For Each k In oDic.Keys
If k = "Mots clés" Then ' attention "Mots clés" est en français !!!
chaine = oDic(k)
If Left(chaine, 13) = keyOfProp Then
'Récupère la valeur en fonction de sa clé
'..... ..................................
valeurs = Split(chaine, ";")For i = 0 To UBound(valeurs)
paire = Split(valeurs(i), ":")
If LCase(Trim(paire(0))) = LCase(Trim(keyOfProp)) Then
chaine = paire(1) ' La clé a été trouvée, récupération de la valeur correspondante
Exit For
End If
Next i
'.....
M2_GetKeywordPropertyValue_4ClosedDoc = chaine
Exit Function
End If
End If
NextIf Not oDic Is Nothing Then Set oDic = Nothing
End Function' -----------------------------
Function M2_GetFileProperties(ByVal sFile As String) As Object
On Error GoTo Error_Handler
Dim oDic As Object 'Scripting.Dictionary
Dim oShell As Object 'Shell
Dim oFolder As Object 'Folder
Dim oFolderItem As Object 'FolderItem
Dim sFilePath As String
Dim sFileName As String
Dim i As Long
Dim vPropValue As VariantsFilePath = Left(sFile, InStrRev(sFile, "\") - 1)
sFileName = Right(sFile, Len(sFile) - InStrRev(sFile, "\"))Set oDic = CreateObject("Scripting.Dictionary")
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.NameSpace(CStr(sFilePath))If (Not oFolder Is Nothing) Then
Set oFolderItem = oFolder.ParseName(sFileName)
For i = 0 To 320 'This could be bumped up in case MS increase the number again
vPropValue = oFolder.GetDetailsOf(oFolderItem, i)
If Trim(vPropValue & vbNullString) <> "" Then
vPropValue = Replace(Replace(Replace(Replace(vPropValue, ChrW(8236), ""), ChrW(8234), ""), ChrW(8207), ""), ChrW(8206), "")
oDic.Add oFolder.GetDetailsOf(oFolder.Items, i), vPropValue
End If
Next
End IfSet M2_GetFileProperties = oDic
End Function
-
