Question

我有一个包含文档列表（Word，Excel和PowerPoint）的Excel工作表。对于每个文档，我都有一个版本号和批准日期。

我想使用文档名称（文件名），相应的版本（可能是表单字段或标签）和文档包含的日期（链接到版本）自动更新此列表。

最好的方法是什么？

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

在Excel中创建外部文档及其属性的列表

1 个答案: