macro to fill in file property contents   

Hi all.
One of my colleagues has written a macro to fill in the property comments, 
contents, etc... for Excel workbooks.
As I've studied it, I've realized that it will not entirely work for doing 
the same in Word. I'd need to have it look for strings of text on lines (of 
what I'm assuming would be akin to a single cell if I were to attempt to 
correlate it to Excel), instead of looking in specific cells. 
While I've been using Word for close to a decade now, I've never written a 
macro for anything in Word.

1- We have a series of standard letters that we use on a regular basis. 
2- To keep track of these letters there has been discussion of filling in 
the various components of the properties.
Author, title, keywords, subject, comments, status, and category.
3- If I understand this correctly, I want to look through the entire 
letter's contents for specific string elements to place in each field of the 
document's properties.
I.e.,
A- Look for the name of the "signee" to place in the author's box.
B- Look for a number, or word/number string to place in the title box. 
C- Look for a letter type (we have 4 general types of letters, Confirmation, 
rejection, deficiency, errata request) of string that defines the type of 
letter to be placed in the Subject box.
D- Look for a combination of Recipent's name, and numeric value to be placed 
in the Keywords box.
E- Look for letter type to place a word in the status box.

If further explanation is required, please advise, and I'll do what I can.

Below is a copy of the two macros-- the first for clearing out the property 
contents, and the second for filling it with the new data.
Also, it is being used as a menu item within a custom made ribbon, so ignore 
the Control As IRibbonControl statement.

Thank you for your help.
Regards.

Sub ClearFileProps(Optional Control As IRibbonControl)
'
' ClearFileProps Macro
' 
'
' Keyboard Shortcut: Ctrl+Shift+f

Dim strTitle As String
Dim strSubject As String
Dim strAuthor As String
Dim strManager As String
Dim strCompany As String
Dim strCategory As String
Dim strComment As String
Dim myChar

myChar = Chr(32)
strSubject = ""

If (Range("B15") <> "") = True Then
strTitle = Range("B15").Value & " " & (Range("B16").Value)
End If
If (Range("B16") <> "") = True Then
strTitle = Range("B16").Value & " " & (Range("B17").Value)
strTitle = Trim(strTitle)
End If
If (Range("B17") <> "") = True And (Range("B16") <> "" = True) Then
strTitle = Range("B16").Value & " " & (Range("B17").Value)
strTitle = Trim(strTitle)
End If
If ((Range("B17") <> "" = True) And (Range("B16") <> "" = False)) Then
strTitle = Range("B17").Value
strTitle = Trim(strTitle)
End If
If (Range("B18") <> "") = True And (Range("B17") <> "" = True) Then
strTitle = ((Range("B15").Value) & " " & (Range("B16").Value) & " " & 
(Range("B17").Value) & " " & (Range("B18").Value))
strTitle = Trim(strTitle)
End If

If (Range("B18") <> "") = True And (Range("B17") <> "" = False) Then
strTitle = ((Range("B15").Value) & " " & (Range("B16").Value) & " " & 
(Range("B17").Value) & " " & (Range("B18").Value))
strTitle = Trim(strTitle)
End If

If (Range("F12").Value <> "") = True Then
strAuthor = Range("F12").Value
End If
If (Range("F12").Value = "") = True Then
strAuthor = Range("F10").Value
End If

strManager = "Document Control"
strCompany = "Division of Water Resources"
strCategory = "Computerized Assignment Forms"
strComment = ""
    
    ActiveWorkbook.BuiltinDocumentProperties("Title").Value = strTitle
    ActiveWorkbook.BuiltinDocumentProperties("Subject").Value = strSubject
    ActiveWorkbook.BuiltinDocumentProperties("Author").Value = strAuthor
    ActiveWorkbook.BuiltinDocumentProperties("Manager").Value = strManager
    ActiveWorkbook.BuiltinDocumentProperties("Company").Value = strCompany
    ActiveWorkbook.BuiltinDocumentProperties("Category").Value = strCategory
    ActiveWorkbook.BuiltinDocumentProperties("Comments").Value = strComments
  
End Sub


Public Sub FillFilePropsComments(Optional Control As IRibbonControl)

Dim ws As Worksheet
Dim Strlist() As String   ' list for permit numbers
Dim ptr As Integer        ' pointer/ counter for strList
Dim PermitNumber As Variant
Dim DupFound As Boolean
Dim strComment As String
Dim PropAuthor As String

ptr = 0 ' init pointer - currently there are zero permit numbers in list
ReDim Strlist(1 To Sheets.Count) ' init size of list, should not be more 
Permits than sheets

For Each ws In Worksheets
    PermitNumber = GetPermitNumber(ws) ' get the permit number
    DupFound = False                    ' assume it is not already in list
    For i = ptr To 1 Step -1            ' start from back of list, see if it 
is a dup
        If PermitNumber = Strlist(i) Then
            DupFound = True
            Exit For
        End If
    Next i
    If Not DupFound Then ' it is not already in list
        ptr = ptr + 1    ' make a place for it in the list by pointing to 
next empty slot
        Strlist(ptr) = PermitNumber ' store new permit number
    End If
Next ws

ReDim Preserve Strlist(1 To ptr) ' resize list to number of permits
QuickSort Strlist, LBound(Strlist), UBound(Strlist) ' sort the list

For i = 1 To ptr ' get the list into one long string
    strComment = strComment & Strlist(i) & ", "
Next i
' store the string in the File>Comments Property box
    ActiveWorkbook.BuiltinDocumentProperties("Comments").Value = strComment
   
End Sub

date: Thu, 17 Jan 2008 14:04:00 -0800   author:   SteveDB1

Re: macro to fill in file property contents   

Unless your data is using a template where the information you require
is easily identifyable, such as bookmarks or formfields, it would be
difficult to accurately locate that information with code.

I would create a userform that contained a option button for each of
the groups you want.

> Author, title, keywords, subject, comments, status, and category.

In that userform, I would setup a label that represented the selected
text along with the groups in a option button, and a OK and Cancel
button.

So, you would paruse through the document looking for key pieces of
info.  You would then select it with the mouse.  Run the macro.  The
userform will popup, and using the label, it would show the text you
have selected.  Then, simply select the option button for the group
you want, and press OK.  The code would determine which option button
was selected and that info will be sent to the Doc.Properties.

date: Fri, 25 Jan 2008 13:45:01 -0800 (PST)   author:   David Sisson