Создание списка внешних документов с их свойствами в Excel

Question

У меня есть лист Excel, содержащий список документов (Word, Excel и PowerPoint).Для каждого из этих документов у меня есть номер версии и дата утверждения.

Я бы хотел автоматизировать обновление этого списка именами файлов (именами файлов), соответствующими версиями (возможно, в виде поля формы илитег) и даты (связанные с версиями), содержащиеся в документе.

Каков наилучший способ сделать это?

Answer 1

Это то, что я получил до сих пор, но это немного уродливо, и часть Publischer не работает.

Option Explicit

Sub ExtractMetaData()

    Application.ScreenUpdating = False

    Sheets("Files").Activate
    Range("a1").Offset(1, 0).Select
    While Selection.Value <> ""
        If Right(Selection.Offset(0, 1), 4) = "docx" Then Call ExtractMetaDataWord
        If Right(Selection.Offset(0, 1), 4) = "xlsx" Then Call ExtractMetaDataExcel
        If Right(Selection.Offset(0, 1), 4) = "xlsm" Then Call ExtractMetaDataExcel
        If Right(Selection.Offset(0, 1), 3) = "pub" Then Call ExtractMetaDataPublischer
        Sheets("Files").Activate
        Selection.Offset(1, 0).Select
    Wend

End Sub
Sub ExtractMetaDataWord()
    Dim objWord As Object
    Dim strProperty As Object
    Dim objDoc As Object
    Dim objExcel As Object
    Dim objXls As Object

    Set objWord = CreateObject("Word.Application")
    objWord.Visible = False

            Set objDoc = objWord.Documents.Open(Filename:=Selection & "\" & Selection.Offset(0, 1))
            Sheets("Metadata").Activate
            Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).Select
            Selection.Offset(1, 0).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 objDoc.CustomDocumentProperties
                    On Error Resume Next
                        Selection = objDoc.Name
                        If strProperty.Name = "Dokumentnummer" Then Selection.Offset(0, 1) = strProperty.Value
                        If strProperty.Name = "Version" Then Selection.Offset(0, 2) = strProperty.Value
                        If strProperty.Name = "Daterad" Then Selection.Offset(0, 3) = strProperty.Value
                        'Selection.Offset(0, 2) = strProperty.Value
                        'Selection.Offset(0, 3) = Now()
                        'Selection.Offset(1, 0).Select
                Next
            objDoc.Close

    objWord.Quit
    Set objWord = Nothing
    Set objDoc = Nothing
    Set strProperty = Nothing

    Application.ScreenUpdating = True

End Sub

Sub ExtractMetaDataExcel()
    Dim objExcel As Object
    Dim strProperty As Object
    Dim objXls As Object

    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False

        Set objXls = Workbooks.Open(Filename:=Selection & "\" & Selection.Offset(0, 1))
        ThisWorkbook.Sheets("Metadata").Activate
        Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).Select
        Selection.Offset(1, 0).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 objXls.CustomDocumentProperties
            On Error Resume Next
                Selection = objXls.Name
                    If strProperty.Name = "Dokumentnummer" Then Selection.Offset(0, 1) = strProperty.Value
                    If strProperty.Name = "Version" Then Selection.Offset(0, 2) = strProperty.Value
                    If strProperty.Name = "Daterad" Then Selection.Offset(0, 3) = strProperty.Value
                    'Selection.Offset(0, 2) = strProperty.Value
                    'Selection.Offset(0, 3) = Now()
                    'Selection.Offset(1, 0).Select
        Next
        objXls.Close


    objExcel.Quit
    Set objExcel = Nothing
    Set objXls = Nothing
    Set strProperty = Nothing

    Application.ScreenUpdating = True

End Sub

Sub ExtractMetaDataPublischer()
    Dim objPublischer As Object
    Dim strProperty As Object
    Dim objPub As Object

    Set objPublischer = CreateObject("Publisher.Application")
   ' objPublischer.Visible = False

            Set objPub = objPublischer.Open(Filename:=Selection & "\" & Selection.Offset(0, 1))
            Sheets("Metadata").Activate
            Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).Select
            Selection.Offset(1, 0).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 objPub.CustomDocumentProperties
                    On Error Resume Next
                        Selection = objPub.Name
                        If strProperty.Name = "Dokumentnummer" Then Selection.Offset(0, 1) = strProperty.Value
                        If strProperty.Name = "Version" Then Selection.Offset(0, 2) = strProperty.Value
                        If strProperty.Name = "Daterad" Then Selection.Offset(0, 3) = strProperty.Value
                        'Selection.Offset(0, 2) = strProperty.Value
                        'Selection.Offset(0, 3) = Now()
                        'Selection.Offset(1, 0).Select
                Next
            objPub.Close

    objPublischer.Quit
    Set objPublischer = Nothing
    Set objPub = Nothing
    Set strProperty = Nothing

    Application.ScreenUpdating = True

End Sub