I have butchered an existing macro (as I don't have the knowledge to write one from scratch) to attempt to prompt Word (2007/2010) users in my workplace to add document properties at the point of closing their document (I have included the macro below). It works fine other than I don't know how to achieve two other specific aims:

1. How can I prompt for the property called 'Status'? I want users to be prompted so that it will save the document with Draft/Final status etc.

2. The macro at the moment has specific text pre-included in the form (e.g. add author name here), but how do i set the default text to be that already existing for that property, so the users don't have to start from scratch when adding this information each time they close the document?

Any help much apprecaited.

Macro:

Sub AutoClose()

Dim Title As String
Dim Author As String
Dim Subject As String
Dim oStory As Range
Dim oShp As Shape

Title = InputBox("Enter the Document Title:", "Title", "Title Here")
Author = InputBox("Enter the Document Author:", "Author", "Author Here")
Subject = InputBox("Enter the Client and Site Name:", "Subject", "Client - Site Name Here")
ActiveDocument.BuiltInDocumentProperties("Title"). Value = Title
ActiveDocument.BuiltInDocumentProperties("Subject" ).Value = Subject
ActiveDocument.BuiltInDocumentProperties("Author") .Value = Author
For Each oStory In ActiveDocument.StoryRanges
Do
On Error Resume Next
oStory.Fields.Update
Select Case oStory.StoryType
Case 6, 7, 8, 9, 10, 11
If oStory.ShapeRange.Count > 0 Then
For Each oShp In oStory.ShapeRange
If oShp.TextFrame.HasText Then
oShp.TextFrame.TextRange.Fields.Update
End If
Next oShp
Set oShp = Nothing
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set oStory = oStory.NextStoryRange
Loop Until oStory Is Nothing
Next oStory
Set oStory = Nothing
End Sub