Write Properties Title from Info inside .doc

[whisperinghi]

I have a bunch of files that have been copied and altered , so a lot of the Title Properties are identical. I have a macro and can batch fill in the Properties "Title" block but want to rewrite the file properties from a specific area of the file

Example the following information is in a table at the top of the document

QUOTE] Preventive Maintenance Procedure
DuPont, Washington Number: PMP-E-0003 Rev: 1 Date: 2/04/99
Title: DP2-LC210 Lighting Control Panel - Annual
[/quote]

I have a macro that will Find "title:" and select next 51 characters. That part of the macro functions properly, I have tried to call that selection w but obviously it is not written correctly.
The sValue, is required to be a string like as below. I have the Call routine and it works If I use it with a string value.
Code:

Call WriteProp(sPropName:="Title", sValue:="")




Public Sub WriteProp(sPropName As String, sValue As String, _
Optional lType As Long = msoPropertyTypeString)
'In the above declaration, "Optional lType As Long = msoPropertyTypeString" means
'that if the Document Property's Type is Text, we don't need to include the lType argument
'when we call the procedure; but if it's any other Prpperty Type (e.g. date) then we do
Dim bCustom As Boolean
On Error GoTo ErrHandlerWriteProp
'Try to write the value sValue to the custom documentproperties
'If the customdocumentproperty does not exists, an error will occur
'and the code in the errorhandler will run
ActiveDocument.BuiltInDocumentProperties(sPropName).Value = sValue
'Quit this routine
Exit Sub
Proceed:
'We know now that the property is not a builtin documentproperty,
'but a custom documentproperty, so bCustom = True
bCustom = True
Custom:
'Try to set the value for the customproperty sPropName to sValue
'An error will occur if the documentproperty doesn't exist yet
'and the code in the errorhandler will take over
ActiveDocument.CustomDocumentProperties(sPropName).Value = sValue
Exit Sub
AddProp:
'We came here from the errorhandler, so know we know that
'property sPropName is not a built-in property and that there's
'no custom property with this name
'Add it
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add Name:=sPropName, _
LinkToContent:=False, Type:=lType, Value:=sValue
If Err Then
'If we still get an error, the value isn't valid for the Property Type
'e,g an invalid date was used
Debug.Print "The Property " & Chr(34) & _
sPropName & Chr(34) & " couldn't be written, because " & _
Chr(34) & sValue & Chr(34) & _
" is not a valid value for the property type"
End If
Exit Sub
ErrHandlerWriteProp:
Select Case Err
Case Else
'Clear the error
Err.Clear
'bCustom is a boolean variable, if the code jumps to this
'errorhandler for the first time, the value for bCustom is False
If Not bCustom Then
'Continue with the code after the label Proceed
Resume Proceed
Else
'The errorhandler was executed before because the value for
'the variable bCustom is True, therefor we know that the
'customdocumentproperty did not exist yet, jump to AddProp,
'where the property will be made
Resume AddProp
End If
End Select
End Sub


but have no clue on how to reference this area sValue:= ???? )
Code:

Call WriteProp(sPropName:="Title", sValue:="")

Can someone give me a clue on the below macro? Thanks



Sub Find_title()
'
' Macro1 Macro
' Macro recorded 1/13/2007 by Bud Edwards
'
Dim w As Object, Str As String
For Each w In ActiveDocument.Words
Selection.Find.ClearFormatting
With Selection.Find
.Text = "title:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=51, Extend:=wdExtend
Selection.Copy
Call WriteProp(sPropName:="Title", sValue:= ???? )
Next
End
End Sub

[whisperinghi]

It was simple when I found another macro that was similar

I was trying this
Dim w As Object, Str As String



Sub Find_title()
'
' This selects text starting with "Title:" and 51 more characters and
' writes to Documentb Properties "Title"
Dim title As String
title = Selection.Text
Selection.Find.ClearFormatting
With Selection.Find
.Text = "title:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=51, Extend:=wdExtend
Call WriteProp(sPropName:="Title", sValue:=title)


End Sub


If you are looking for an answer for me, never mind. I actually found the information in the VBA Help File by searching for Type Block and Selection Object was one of the choices.