AJOUTER LE NOM DE L’AUTEUR D’UN FICHIER

Accueil – Le CFO masqué Forums Power Query AJOUTER LE NOM DE L’AUTEUR D’UN FICHIER

5 sujets de 1 à 5 (sur un total de 5)
  • Auteur
    Articles
  • #98450
    mgaignard
    Participant

    Bonjour,

    Je dois realiser la cartographie d’un dossier, en ajoutant les noms des differents auteurs des fichiers de ce dossier dans une colonne.
    Les noms se trouvent sous “proprietes”- “details” -“origines”- “auteurs” mais comment ajouter cette information directement dans une colonne en face de chaque fichier avec Power query ?
    Sachant que j’ai beaucoup de fichiers, il n’est pas imaginablale d’ajouter cette information manuellement.

    Une idée ?

    MG

    #98675
    Daniel Blanc
    Participant

    Bonjour,
    Pas certain que cela soit possible de retrouver les metadonnées d’un fichier Excel ou Word avec Power query, par contre avec une macro Excel, on peut lister les propriétés d’un fichier et les mettre dans un fichier excel et ensuite établir une fusion entre ce fichier et celui contenant les données à importer, cela permettra d’ajouter l’auteur par exemple. Le classeur doit contenir deux feuilles de calcul nommées respectivement “Metadata” et “Files”, la feuille Files contiendra deux résultat de requêtes Power query (voir ci après)

    Requêtes Power query
    Excel

    let
        Source = Folder.Files(FolderPath),
        FilteredRows = Table.SelectRows(Source, each Text.EndsWith([Extension], "xlsx") or Text.EndsWith([Extension], "xls")),
        RemovedColumns = Table.RemoveColumns(FilteredRows,{"Extension", "Date accessed", "Date modified", "Date created", "Attributes", "Content"}),
        ReorderedColumns = Table.ReorderColumns(RemovedColumns,{"Folder Path", "Name"})
    in
        ReorderedColumns
    

    Word

    let
        Source = Folder.Files(FolderPath),
        FilteredRows = Table.SelectRows(Source, each Text.EndsWith([Extension], "docx") or Text.EndsWith([Extension], "doc")),
        RemovedColumns = Table.RemoveColumns(FilteredRows,{"Extension", "Date accessed", "Date modified", "Date created", "Attributes", "Content"}),
        ReorderedColumns = Table.ReorderColumns(RemovedColumns,{"Folder Path", "Name"})
    in
        ReorderedColumns
    

    FolderPath est un paramètre contenant le nom du dossier contenant les fichiers à traiter.
    Macro pour des fichiers Excel

    
    Sub ExtractMetaDataExcelDoc()
        Dim objExcel As Object
        Dim strProperty As Object
        Dim ts As ListObject, intCptLine As Integer, tsRow As Integer, tsCol As Integer
        Dim wb As Workbook, wsFiles As Worksheet, wsMetaData As Worksheet
        
        Application.ScreenUpdating = False
        'Application.ScreenUpdating = True
      
        Set wb = ActiveWorkbook
        Set wsFiles = wb.Sheets("Files")
        Set wsMetaData = wb.Sheets("Metadata")
        wsFiles.Activate
        intCptLine = 2
        Set ts = Sheets("Files").ListObjects("ExcelFiles")
        tsRow = ts.Range.Row + 1
        tsCol = ts.Range.Column
        Cells(ts.Range.Row + 1, ts.Range.Column).Select
        
        While wsFiles.Cells(tsRow, tsCol).Value <> ""
            Set objExcel = Workbooks.Open(wsFiles.Cells(tsRow, tsCol).Value & wsFiles.Cells(tsRow, tsCol).Offset(0, 1).Value, False)
            wsMetaData.Activate
            Cells(intCptLine, 1).Select
            'If Range("A1").End(xlDown).Row = 2 Then Range("A1").End(xlDown).Activate Else Range("A1").End(xlDown).Offset(1, 0).Activate
              For Each strProperty In objExcel.BuiltinDocumentProperties
                On Error Resume Next
                    ActiveCell.Value = objExcel.Name
                    If strProperty.Name = "Author" Or strProperty.Name = "Auteur" Then
                      ActiveCell.Offset(0, 1).Value = strProperty.Name
                      ActiveCell.Offset(0, 2).Value = strProperty.Value
                      ActiveCell.Offset(0, 3).Value = Now()
                      intCptLine = intCptLine + 1
                      Exit For
                    End If
                    ActiveCell.Offset(1, 0).Value.Select
            Next
            
            Workbooks(objExcel.Name).Close False
            wsFiles.Activate
            tsRow = tsRow + 1
            Cells(tsRow, tsCol).Select
        Wend
        
        Set strProperty = Nothing
        
        Sheets("Metadata").Select
        Range("A1").End(xlDown).Offset(1, 2).Value = "EOF"
        Range("C1").Select
        While Selection <> "EOF"
            Selection.Offset(1, 0).Select
            If Selection = "" Then
                Selection.EntireRow.Delete
                Selection.Offset(-1, 0).Select
            End If
        Wend
        Selection.EntireRow.Delete
        Range("A1").Select
        Application.ScreenUpdating = True
    
    End Sub
    

    Macro pour des fichiers Word

    
    Sub ExtractMetaDataWordDoc()
        Dim objWord As Object
        Dim strProperty As Object
        Dim objDoc As Object
        
        Application.ScreenUpdating = False
    
        Set objWord = CreateObject("Word.Application")
        objWord.Visible = False
            
        Sheets("Files").Activate
        Range("a1").Offset(1, 0).Select
        
        While Selection.Value <> ""
            Set objDoc = objWord.Documents.Open(Selection & Selection.Offset(0, 1).Value)
            Sheets("Metadata").Activate
            If Range("A1").End(xlDown).Row = 2 Then Range("A1").End(xlDown).Activate Else Range("A1").End(xlDown).Offset(1, 0).Activate
            For Each strProperty In objDoc.BuiltinDocumentProperties
                On Error Resume Next
                    Selection = objDoc.Name
                    If strProperty.Name = "Author" Or strProperty.Name = "Auteur" Then
                      Selection.Offset(0, 1) = strProperty.Name
                      Selection.Offset(0, 2) = strProperty.Value
                      Selection.Offset(0, 3) = Now()
                    End If
                    Selection.Offset(1, 0).Select
            Next
            objDoc.Close
            Sheets("Files").Activate
            Selection.Offset(1, 0).Select
        Wend
        
        objWord.Quit
        Set objWord = Nothing
        Set objDoc = Nothing
        Set strProperty = Nothing
        
        Sheets("Metadata").Select
        Range("A1").End(xlDown).Offset(1, 2).Value = "EOF"
        Range("C1").Select
        While Selection <> "EOF"
            Selection.Offset(1, 0).Select
            If Selection = "" Then
                Selection.EntireRow.Delete
                Selection.Offset(-1, 0).Select
            End If
        Wend
        Selection.EntireRow.Delete
        Range("A1").Select
        Application.ScreenUpdating = True
    End Sub
    

    En espérant que cela vous aidera à résoudre votre problème.
    Cordialement

    #98775
    mgaignard
    Participant

    Bonjour Daniel,

    merci beaucoup !
    Malheureusement je ne gère pas très bien le langage informatique,
    j’ai cette ligne en jaune (Macro pour des fichiers Word), mais je ne sais pas ce qui ne convient pas:
    Range(“A1”).End(xlDown).Offset(1, 2).Value = “EOF”

    Marion

    #98805
    Daniel Blanc
    Participant

    Bonjour,

    La ligne en question n’est là que pour écrire EOF dans la dernière ligne et permettre ainsi de supprimer toutes les lignes inutiles qui ont été générées par les lignes situées avant Sheets(“Metadata”).select.
    Appuyer sur la touche F5, cela devrait déclancher la suite du code et régler le soucis pour les fois suivantes, j’ai fait l’essai sur ma version et cela fonctionne.
    Cordialement

    #98973
    mgaignard
    Participant

    MERCI BEAUCOUP !

5 sujets de 1 à 5 (sur un total de 5)
  • Vous devez être connecté pour répondre à ce sujet.