Document properties placed in a cell

Yes

Try this code;

Sub SelectFile()
Dim sDir As String
Dim sFile As String
Dim oWordApp As Object 'As Word.Application = EarlyBinding
Dim oWordDoc As Object 'As Word.Document = EarlyBinding

'Use LateBinding instead of EarlyBinding
'Unless using static variable to stop object loosing scope
Range(Range("A1:B1"), Range("A1:B1").End(xlDown)).ClearContents

sFile = Application.GetOpenFilename("Word files (*.Doc), *.Doc", Title:="Select a Word Document")
If sFile = "False" Then Exit Sub

Set oWordApp = CreateObject("Word.Application")
Set oWordDoc = oWordApp.Documents.Open(Filename:=sFile, ReadOnly:=True)

Dim oProp As Object
Dim x As Integer
x = 2

Cells(1, 1) = "File Properties for:> "
Cells(1, 2) = sFile

For Each oProp In oWordDoc.BuiltinDocumentProperties
Cells(x, 1) = oProp.Name
On Error Resume Next
Cells(x, 2) = oWordDoc.BuiltinDocumentProperties(Cells(x, 1).Text).Value
If Err <> 0 Then
Cells(x, 2) = "<This property is not available/Set>"
End If
On Error GoTo 0
x = x + 1
Next

'Close Word instance
oWordApp.Quit SaveChanges:=False

Range(Range("A1:B1"), Range("A1:B1").End(xlDown)).Columns.AutoFit

Set oWordApp = Nothing
Set oWordDoc = Nothing

MsgBox "Done!", vbInformation
End Sub

HTH

Ivan

Re: Yes Thanks but?

Thanks,

Is it possible to read only certain specific properties.

What I am trying to end up with is a "Master Document Register" which lists:
Document (title), Issue date (date last saved) and possibly author with possibly one or two other properties.

If this is not possible then I can read all the properties onto one sheet and copy and paste to another to give me my list.

Re: Yes Thanks but?

Just a few changes;

Note: Amend select case criteria to what you require;

Sub SelectFile()
Dim sDir As String
Dim sFile As String
Dim oWordApp As Object 'As Word.Application = EarlyBinding
Dim oWordDoc As Object 'As Word.Document = EarlyBinding

'Use LateBinding instead of EarlyBinding
'Unless using static variable to stop object loosing scope
Range(Range("A1:B1"), Range("A1:B1").End(xlDown)).ClearContents

sFile = Application.GetOpenFilename("Word files (*.Doc), *.Doc", Title:="Select a Word Document")
If sFile = "False" Then Exit Sub

Set oWordApp = CreateObject("Word.Application")
Set oWordDoc = oWordApp.Documents.Open(Filename:=sFile, ReadOnly:=True)

Dim oProp As Object
Dim x As Integer
x = 2

Cells(1, 1) = "File Properties for:> "
Cells(1, 2) = sFile

For Each oProp In oWordDoc.BuiltinDocumentProperties
Select Case UCase(oProp.Name)
Case "TITLE", "AUTHOR", "LAST SAVE TIME"
Cells(x, 1) = oProp.Name
On Error Resume Next
Cells(x, 2) = oWordDoc.BuiltinDocumentProperties(Cells(x, 1).Text).Value
If Err <> 0 Then
Cells(x, 2) = "<This property is not available/Set>"
End If
On Error GoTo 0
x = x + 1
End Select
Next

'Close Word instance
oWordApp.Quit SaveChanges:=False

Range(Range("A1:B1"), Range("A1:B1").End(xlDown)).Columns.AutoFit

Set oWordApp = Nothing
Set oWordDoc = Nothing

MsgBox "Done!", vbInformation
End Sub

Re: Yes Thanks but? Thanks I can modify to get what I want (nt)