Why won't CustomDocProperties stick to doc after close??!?

[Ed from AZ]

I have a set of Word files in a folder and a list of values in an
Excel spreadsheet. I'm running a macro in Excel to iterate through
each doc and add the values in the spreadsheet as
CustomDocumentProperties. I have a Debug.Print at the end of the
macro to read the properties from each doc, and the properties are
read just fine.

But when I ran another macro in Excel to iterate throgh the doc and
read these properties into another spreadsheet, the properties weren't
there! When I opened the docs and looked at File >> Properties, no
Custom Properties were listed!

Why won't these stick to the docs??

Ed
(Word and Excel 2000)

Sub AddPropsToSongs()

Dim strDoc As String

Dim wkb As Workbook
Dim wks As Worksheet
Dim x As Long, y As Long

Dim WD As Word.Application
Dim doc As Word.Document

Set wkb = ActiveWorkbook
Set wks = wkb.Worksheets("Songs")

y = wks.Range("B10000").End(xlUp).Row + 1

On Error Resume Next
Set WD = GetObject(, Word.Application)
If WD.Name = "" Then _
Set WD = New Word.Application

WD.Visible = True

For x = 2 To y
If wks.Range("A" & x).Text <> "" Then
strDoc = wks.Range("C" & x).Text
Set doc = WD.Documents.Open(strDoc)

With doc.CustomDocumentProperties
.Add _
Name:="cpFastSlow", LinkToContent:=False, _
Value:=wks.Range("A" & x).Text, _
Type:=msoPropertyTypeString
.Add _
Name:="cpName", LinkToContent:=False, _
Value:=wks.Range("B" & x).Text, _
Type:=msoPropertyTypeString
.Add _
Name:="cpFLine", LinkToContent:=False, _
Value:=wks.Range("D" & x).Text, _
Type:=msoPropertyTypeString
.Add _
Name:="cpCLine", LinkToContent:=False, _
Value:=wks.Range("E" & x).Text, _
Type:=msoPropertyTypeString
End With

doc.Save

Debug.Print doc.CustomDocumentProperties("cpFastSlow").Value
Debug.Print doc.CustomDocumentProperties("cpName").Value
Debug.Print doc.CustomDocumentProperties("cpFLine").Value
Debug.Print doc.CustomDocumentProperties("cpCLine").Value
Debug.Print "****************"

doc.Close

End If
Next x
On Error GoTo 0

EndMe:
WD.Quit
Set WD = Nothing

MsgBox "I'm done!"

End Sub

Sub ReadDocProps()

Dim MyDir As String
Dim strDoc As String

Dim wkb As Workbook
Dim wks As Worksheet
Dim x As Long

Dim WD As Word.Application
Dim doc As Word.Document
Dim prop

On Error Resume Next
Set WD = GetObject(, Word.Application)
If WD.Name = "" Then _
Set WD = New Word.Application
On Error GoTo 0

Set wkb = ActiveWorkbook
Set wks = wkb.Worksheets("Sheet1")
x = 0

MyDir = "C:\Documents and Settings\Ed\Desktop\Songs"
strDoc = Dir(MyDir & "\*.doc")

While strDoc <> ""
Set doc = WD.Documents.Open(MyDir & "\" & strDoc)
x = wks.Range("A10000").End(xlUp).Row + 1

wks.Cells(x, 1) = doc.CustomDocumentProperties("cpFastSlow").Value
wks.Cells(x, 2) = doc.CustomDocumentProperties("cpName").Value
wks.Cells(x, 4) = doc.CustomDocumentProperties("cpFLine").Value
wks.Cells(x, 5) = doc.CustomDocumentProperties("cpCLine").Value
wks.Cells(x, 3) = MyDir & "\" & strDoc

doc.Close

strDoc = Dir()

Wend

wkb.Save

EndMe:
WD.Quit
Set WD = Nothing

MsgBox "I'm done!"

End Sub

 

[Jonathan West]

Hi Ed

Two possibilities spring to mind

1. Do the properties already exist in the document? If so, using the Add
method isn't the way to proceed, you need to just change ther Value.

2. Sometimes, adding properties doesn't change the Saved status, so the
doc.Save command will have no effecrt. Try preceding it with "doc.Saved =
False"

 

[Ed from AZ]

2. Sometimes, adding properties doesn't change the Saved status, so the

doc.Save command will have no effecrt. Try preceding it with "doc.Saved =
False"

Jonathan, that was it!! Thank you!!!!

Ed