Anyone who makes a folder list for us does it in MSWord (easiest to train,
most people already can use) using a template that has a 4-column table, so
that the data are identified by type. The column heads in the table are:
Folder title | Physical extent | Box number | Note
When the archivist assembles the finding aid, he or she uses an MSWord
macro to turn the tables into valid EAD, copies the EAD from Word, and
pastes it into XMetal. If an archivist after the fact wants to take some
of the info. in <note> and encode it more specifically, he or she can do so
in Xmetal.
Because
a) don't encode <unitdate> at the item level (if there are dates, they go
into the folder title separated by a comma),
b) we don't use numbered <c>s but instead use recursive <c>s with explicit
"level" attribute values, and
c) we don't typically have folder numbers,
this would not work in too many places, but I've put the macro below as an
example of what _can_ be done.
For the macro to work, the column heads must be exact and there must be
data in every row in the box number column.
Sub macEAD4Columns()
'
' macEAD1 Macro
' Macro recorded 10/19/2004 by kate
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.ClearFormatting
With Selection.Find
.Text = "folder 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.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "folder 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.Tables(1).Select
Selection.Copy
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
Selection.PasteAndFormat (wdPasteDefault)
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "folder title"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.EscapeKey
Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _
True
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^t^t^t^p"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'
' macEAD2 Macro
' Macro recorded 10/19/2004 by kate
'
Selection.HomeKey Unit:=wdStory
Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=4, _
NumRows:=6, AutoFitBehavior:=wdAutoFitContent
With Selection.Tables(1)
.Style = "Table Grid"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
Selection.Find.ClearFormatting
With Selection.Find
.Text = "folder 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.InsertColumnsRight
Selection.InsertColumnsRight
Selection.InsertColumnsRight
Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _
True
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^t^t^t^t"
.Replacement.Text = "</unittitle> <physdesc> <extent> ("
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=3, _
NumRows:=6, AutoFitBehavior:=wdAutoFitContent
With Selection.Tables(1)
.Style = "Table Grid"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
'
' macEAD3 Macro
' Macro recorded 10/19/2004 by kate
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Box Number"
.Replacement.Text = "</unittitle> <physdesc> <extent> ("
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.InsertColumns
Selection.InsertColumns
Selection.InsertColumns
Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _
True
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^t^t^t^t"
.Replacement.Text = ") </extent> </physdesc> <container> Box "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "<physdesc> <extent> () </extent> </physdesc>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'
' macEAD4 Macro
' Macro recorded 10/19/2004 by kate
'
Selection.HomeKey Unit:=wdStory
Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=2, _
NumRows:=6, AutoFitBehavior:=wdAutoFitContent
With Selection.Tables(1)
.Style = "Table Grid"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "note"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.InsertColumns
Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _
True
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^t^t"
.Replacement.Text = "</container> <note><p> "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p"
.Replacement.Text = _
".</p> </note> </c>^p<c level=""item""><did> <unittitle>"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "</container>"
.Replacement.Text = "</container> </did>"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = ".."
.Replacement.Text = "."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'
' macEADcleanup Macro
' Macro recorded 10/19/2004 by kate
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = _
"Folder Title</unittitle> <physdesc> <extent> (Physical
extent) </extent> </physdesc> <container> Box Box Number</container> </did>
<note><p> Note.</p> </note> </c>^p"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "<note><p> .</p> </note>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "<c level=""item""><did> <unittitle>.</p> </note> </c>^p"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "<c level=""item"""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
'
' macEADCleanup2 Macro
' Macro recorded 10/19/2004 by kate
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "<c level=""item""><did> <unittitle>^p"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Kate Bowers
Processing Archivist
Harvard University Archives
Cambridge, MA 02138
voice: (617) 495-2461
fax: (617) 495-8011
email: [log in to unmask]
|