XL 2016 Récupérer certains information des fichiers dans un répertoire

blord

XLDnaute Impliqué
Bonjour tout le monde,
Est-ce que vous savez s'il est possible de récupérer les propriétés "Nombre de mots" et "Page" pour un fichier WORD dans un répertoire ?

Répertoire.jpg


J'ai plusieurs milliers de fichiers WORD pour lesquels ont doit compiler le nombre de mots et de pages afin de faire une évaluation pour une traduction et ces informations seraient la base de cette évaluation.

Merci d'avance à tous pour votre contribution !

Blord
 

blord

XLDnaute Impliqué
Bonjour à tous, kiki29,

Merci, grâce à ton retour, j'ai réussi à concevoir mon code qui me permet de récupérer les propriétés requises.

VB:
Sub NombrePagesMotsDocumentWord()
    Dim objWrd As Object
    Dim objDoc As Object
 
    Dim DerLig As Long
    Dim i As Long
    
    DerLig = ThisWorkbook.Worksheets("data").Range("A" & ThisWorkbook.Worksheets("data").Rows.Count).End(xlUp).Row
    
    For i = 2 To DerLig Step 1
        Set objWrd = CreateObject("Word.Application")
        objWrd.Visible = False
        
        Set objDoc = objWrd.Documents.Open(ThisWorkbook.Worksheets("data").Cells(i, 3).Value, ReadOnly:=True)
        
        ThisWorkbook.Worksheets("data").Cells(i, 4).Value = objDoc.ComputeStatistics(wdStatisticPages)
        ThisWorkbook.Worksheets("data").Cells(i, 5).Value = objDoc.ComputeStatistics(wdStatisticWords)
        
        objDoc.Close SaveChanges:=wdDoNotSaveChanges
        objWrd.Quit
        Set objWrd = Nothing
    Next i
End Sub

Merci à tous et bonne journée !
Blord
 

kiki29

XLDnaute Barbatruc
Salut, à tester plus à fond
VB:
Private Sub ListeDocumentProperties(sFichier As String, iRowDep As Long)
Dim docProperty As Object
Dim oWrd As Object
Dim oDoc As Object

    Set oWrd = CreateObject("Word.Application")
    Set oDoc = oWrd.Documents.Open(Filename:=sFichier, ReadOnly:=True)
    oWrd.Visible = False

    On Error Resume Next
    oDoc.Repaginate
    For Each docProperty In oDoc.BuiltinDocumentProperties
        With docProperty
            If .Name = "Number of pages" Then ShParam.Cells(iRowDep, 3) = .Value
            If .Name = "Number of words" Then ShParam.Cells(iRowDep, 4) = .Value
        End With
    Next docProperty

    oDoc.Close False
    
    Set oDoc = Nothing
    Set oWrd = Nothing
End Sub
 

Pièces jointes

  • Propriétés.png
    Propriétés.png
    47.5 KB · Affichages: 26
  • Liste_Fichiers_Propriétés_Doc_Word XLD.zip
    43.1 KB · Affichages: 1
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
314 630
Messages
2 111 365
Membres
111 114
dernier inscrit
ADA1327