VBA Excel: Récupérer les propriétés de Word

Résolu/Fermé

Galgante - 27 oct. 2010 à 09:33
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 27 oct. 2010 à 14:21

Bonjour,

Je tente de faire un programme en VBA permettant d'inscrire les propriétés des fichiers Word contenus dans un répertoir dans un tableau Excel. Les propriétés ciblées sont Titre, Auteur, Mots Clés, Nom, Nom Fichier et Créé le.

Dans un premier temps je voudrais tester le programme sur un fichier seul et récupérer n'importe quelle propriété.

Voici mon code (qui ne fonctionne pas...)


Sub testtt() 'affichage des propriété d'un fichier ds cellules excel
    Dim objDoc As Word.Document, msg As String
    Dim rw As Integer
    rw = 1
    Set objDoc = Application.Documents.Open(ChoiFich)
    For Each p In objDoc.BuiltinDocumentProperties
        Worksheets("Feuil1").Cells(rw, 1).Value = p.Name
        rw = rw + 1
    Next
End Sub

Et voici ChoiFich, qui permet de sélectionner le fichier:

Function ChoiFich() As String 'Choix d'un fichier + Renvoi de son chemin d'accès
  Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = False
  Application.FileDialog(msoFileDialogFilePicker).Show
  ChoiFich = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
End Function

Quelqu'un aurait-il une solution ?

Je voulais par la même occasion savoir comment déclarer dans le code les références supplémentaires à activer pour utiliser le programme (pour éviter les erreurs lors de l'utilisation sur un autre ordinateur).

Merci.

A voir également:

VBA Excel: Récupérer les propriétés de Word
Liste déroulante excel - Guide
Formule excel - Guide
Si et excel - Guide
Aller à la ligne excel - Guide
Mise en forme conditionnelle excel - Guide

2 réponses

Réponse 1 / 2

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 27/10/2010 à 10:08

Bonjour,

avec la bibkiothèque FSO tu n'as pas besoin d'ouvrir le doc

macros de silkyroad sur DVP (j'ai supprimmé l'activation de la dll " scripting runtime" par la création de l'objet scripting.FSO). ce code est valable sur tout type de fichiers
sourceDVP:
https://silkyroad.developpez.com/VBA/ProprietesClasseurs/#LIV

Sub Test() 
    proprietesFichier_getFile "D:\Documents\doc1.doc" 
End Sub 


Sub proprietesFichier_getFile(Fichier As String) 
    Dim cible As Object 
    Dim valeur As Object 
    Dim Resultat As String 
     
    Set cible = CreateObject("Scripting.fileSystemObject") 
    Set valeur = cible.GetFile(Fichier) 
     
    Resultat = "Chemin et nom complet : " & cible.GetAbsolutePathName(valeur) & Chr(10) & Chr(10) & _ 
    "Chemin : " & cible.GetParentFolderName(valeur) & Chr(10) & Chr(10) & _ 
    "Nom fichier : " & cible.GetFileName(valeur) & Chr(10) & Chr(10) & _ 
    "Nom fichier sans extension : " & cible.GetBaseName(valeur) & Chr(10) & Chr(10) & _ 
    "Extension fichier : " & cible.GetExtensionName(valeur) & Chr(10) & Chr(10) & _ 
    "Chemin : " & valeur.ParentFolder & Chr(10) & Chr(10) & _ 
    "Chemin court : " & valeur.shortpath & Chr(10) & Chr(10) & _ 
    "Nom court : " & valeur.ShortName & Chr(10) & Chr(10) & _ 
    "Date creation : " & valeur.dateCreated & Chr(10) & Chr(10) & _ 
    "Derniere modification : " & valeur.dateLastModified & Chr(10) & Chr(10) & _ 
    "Taille fichier : " & valeur.Size & " octets" & Chr(10) & Chr(10) & _ 
    "Type fichier : " & valeur.Type 

    MsgBox Resultat 

End Sub

Michel

Galgante
27 oct. 2010 à 11:20

Merci pour ta réponse, je vais essayer ça.

Réponse 2 / 2

Galgante
Modifié par Galgante le 27/10/2010 à 14:06

Après relecture des sources que tu m'as indiqué, je suis arrivé à ça:

Sub RaffraichirBDD() 
    ' 
    'Nécessite d'activer la référence Microsoft Shell Controls and Automation 
    ' 
    Dim objShell As Shell32.Shell 
    Dim strFileName As Shell32.FolderItem 
    Dim objFolder As Shell32.Folder 
    Dim i As Byte 
    Dim flag As Integer 'drapeau 
     
    Set objShell = CreateObject("Shell.Application") 
    'Répertoire cible 
    Set objFolder = objShell.Namespace(ChoiDoss) 
     
    flag = 0 
    'boucle sur tous les elements du repertoire 
    For Each strFileName In objFolder.Items 
         
        'Pour que les dosssiers ne soient pas pris en comptes 
        If strFileName.IsFolder = False Then 
            For i = 0 To 15 
                If flag <> 0 Then 
                    Worksheets("Feuil1").Cells(ligne, i + 1) =_ objFolder.GetDetailsOf(strFileName, i) 
                Else 
                    ligne = 1 
                    Worksheets("Feuil1").Cells(ligne, i + 1) =_ objFolder.GetDetailsOf(objFolder.Items, i) 
                    ligne = 2 
                    Worksheets("Feuil1").Cells(ligne, i + 1) =_ objFolder.GetDetailsOf(strFileName, i) 
                End If 
            Next 
            flag = 1 
            ligne = ligne + 1 
        End If 
    Next 
End Sub

J'avais besoin des propriétés avancées des fichiers.

Cordialement.

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
27 oct. 2010 à 14:21

OK, content pour toi car je m'étais aperçu "après" que FSO ne renvoyait pas les propriétés avancées! (auteur pas ex)

Discussions similaires

ouverture d'un fichier excel à partir d'un code VBA

Discussions similaires

Newsletters