View Single Post
 
Old 05-28-2014, 03:50 PM
macropod's Avatar
macropod macropod is offline Windows 7 32bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,527
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

You could use a macro like the following. It's an Excel macro that will go through all the files in a folder, looking for the "Health and Safety" property. The file's name will be output in column 1 and the property value will be output in column 5. You can add more properties to the Select Case statement and, of course, different Excel columns to output their values to.

The macro has its own folder browser, so all you need do is select the folder to process. Note that the code requires you to set a reference to the Word object model in Excel.
Code:
Sub GetWordProcedureData()
     'Note: this code requires a reference to the Word object model
    Application.ScreenUpdating = False
    Dim wdApp As New Word.Application
    Dim wdDoc As Word.Document
    Dim wdDocProp As Object
    Dim strFolder As String, strFile As String
    Dim WkSht As Worksheet, i As Long, j As Long
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub
    Set WkSht = ActiveSheet
    i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
    Set wdApp = CreateObject("Word.Application")
    strFile = Dir(strFolder & "\*.docx", vbNormal)
    While strFile <> ""
        i = i + 1
        Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, _
          AddToRecentFiles:=False, Visible:=False)
        WkSht.Cells(i, 1).Value = strFile
        With wdDoc
            For Each wdDocProp In .CustomDocumentProperties
                With wdDocProp
                    Select Case .Name
                        Case "Health and Safety": WkSht.Cells(i, 5).Value = .Value
                    End Select
                End With
            Next
        End With
        wdDoc.Close SaveChanges:=False
        strFile = Dir()
    Wend
    wdApp.Quit
    Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
    Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote