Released by Randall Miles under a Creative Commons Attribution-Noncommercial (BY-NC) License
Private Sub cmdEAD_Click() On Error GoTo Err_cmdEAD_Click DoCmd.SetWarnings OFF 'Copyright 2009 Cornell University Library. 'This code was originally written by Randall Miles, Technical Services Archivist. 'Kheel Center for Labor-Management Documentation and Archives. '227 Ives Hall 'Cornell University 'Ithaca, NY 14853-3901 'Phone: 607-255-3183 'Fax: 607-255-9641 'E-mail: kheel_center@cornell.edu 'http://www.ilr.cornell.edu/library/kheel/ 'You are free to use this code for any non-commercial purpose provided this copyright notice is left unchanged. 'To use this code for a commercial purposes contact Cornell University Library to obtain permission. 'The purpose of this VBA programming is to take a container list formatted in Microsoft Excel 'and reformat it into valid EAD. The generated EAD container list is exported as a text document, 'which, when opened in an XML editor and added to the front matter, constitutes a full EAD finding aid. Dim rst As New ADODB.Recordset 'All data from the collection table. Dim rst2 As New ADODB.Recordset 'Only the Series and Sub-Series data from the collection table. Dim strBox As String 'Box number and modifier from the collection table, i.e. "1a." Dim strFolder As String 'Folder number and modifier from the collection table, i.e. "1a." Dim strTitle As String 'Series, Sub-Series, or Folder title from collection table. Dim strDate As String 'Series, Sub-Series, or Folder date from collection table. Dim strTags As String 'This variable holds the opening tags, box, folder, title, and date information 'for the record being processed. Dim strTags2 As String 'For Series and Sub-Series headers strTags2 is used to configure the link parameters. 'For files strTags2 is used to normalize dates within the date tag. Dim strTable As String 'Collection number, and table name, from Extract EAD form set in square brackets. Dim intC0 As Integer 'The EAD component level from the recordset for the record where the cursor is,. 'may the the record being processed or the next record in the recordset. Dim strColl As String 'Path name directing where exported text document is save and what it is named. Dim strTab As String 'Used to format indentation in the output, assigned Chr(9) as needed for component level. Dim strScope As String 'The value of the ScopeContent field in the collection table. Dim intScope As Long 'The number of characters in the Scope Content note: Nz(Len(rst!ScopeContent), 0). Dim strClose As String 'This variable holds the set of closing tags for the record being processed. Dim strChr1 As String 'A single quote mark, used where a single quote would choke the code. Dim strChr2 As String 'Two single quote marks, used where a single quote would choke the code. Dim strChr3 As String 'An ampersand, used where an ampersand would choke the code. Dim strChr4 As String 'The HTML entity "&", used where an ampersand would choke the code. Dim intCurrent As Integer 'The EAD component level from the recordset for the record being processed. Dim intIndex As Integer 'VBA generated index used to enforce sequential order of records appended to tblEAD. Dim strLevel As String 'The value, in all lower case letters, needed for the "level" attribute in the Unittitle tag. Dim strLevel2 As String 'The value, capitalized, needed for the "level" attribute in the Unittitle tag. Dim strAttr As String 'Used to make code a little more compact, equals Chr(34) & "deflist" & Chr(34). Dim intCount As Integer 'The number of records returned in recordset rst2. Dim intRecIndex As Integer 'The index number from the collection table for the record where the cursor is, 'may the the record being processed or the next record in the recordset. Dim strDblTab As String 'Used as shortcut and supplement to strTab, always equals Chr(9) & Char(9). Dim strAddress As String 'The full address of the box containing the current record, used as the value for the "label" 'attribute in the "container" tag. A way to imbed stacks locations in the EAD finding aids 'that will be invisible to the public but can be pulled out for staff using a style sheet. 'At this point strAddress = "Location finder off" Dim intAddress As Integer 'Result of a test to see if box has a location, i.e. AddressIndex > 0. strTable = "[" & Me!txtColl & "]" 'Debug.Print "txtColl = " & Me!txtColl 'Debug.Print "strTable = " & strTable 'Check for a collection number in the text box. If not request user to enter one. If strTable = "[]" Then MsgBox "Please enter a collection number in the text box." Else: strColl = "L:\Kheel\Miles\" & Me!txtColl & ".txt" strDblTab = Chr(9) & Chr(9) 'Find and replace all apostrophes in the title and scopecontent fields with two apostrophes. 'Find and replace all ampersands in the title and scopecontent fields with "&". strChr1 = """'""" strChr2 = """''""" strChr3 = """&""" strChr4 = """&""" DoCmd.RunSQL "UPDATE " & strTable & " SET Title = Replace([Title]," & strChr1 & " ," & strChr2 & ");" DoCmd.RunSQL "UPDATE " & strTable & " SET ScopeContent = Replace([ScopeContent]," & strChr1 & " ," & strChr2 & ");" DoCmd.RunSQL "UPDATE " & strTable & " SET Title = Replace([Title]," & strChr3 & " ," & strChr4 & ");" DoCmd.RunSQL "UPDATE " & strTable & " SET ScopeContent = Replace([ScopeContent]," & strChr3 & " ," & strChr4 & ");" 'Pull recordset, rst2, which contains the index number, title, date, and EAD component level for only the records in 'the collection table where there is no box number. The records should be the Series and Sub-Series headers. 'As written this will pull only Series and Sub-Series headers with EAD component level 1 or 2. 'The recordset will be used to construct the list of Series and Sub-Series in the "arrangement" tag that will appear 'above the container list in the guide. Each item in the list will have a link "reference" tag that will point to the 'same header in the container list. rst2.Open "Select [Index], [Title], [Date], [C0] FROM " & strTable & " WHERE [Box] is Null AND [C0] < 3 Order By [Index]", CurrentProject.Connection, adOpenStatic intCount = rst2.RecordCount 'Debug.Print intCount 'The count of rst2 is used to determine whether or not there are any Series headers. If there are no records in the 'recordset the section of code following "If intCount > 0 Then" until "Loop" is skipped. intIndex = 1 'Debug.Print "intIndex = " & intIndex If intCount > 0 Then rst2.MoveFirst Do Until rst2.EOF 'Debug.Print rst2!Index & " " & rst2!Title & " " & rst2!Date intRecIndex = Nz(rst2!Index, 0) 'Debug.Print "intRecIndex = " & intRecIndex strTitle = Nz(rst2!Title, "") 'Debug.Print "strTitle = " & strTitle strDate = Nz(rst2!Date, 0) 'Debug.Print "strDate = " & strDate intC0 = Nz(rst2!C0, 1) If strDate Like "*[a-z]*" Then strDate = 0 ElseIf strDate Like "*,*" Then strDate = Left(strDate, 4) & "-" & Right(strDate, 4) ElseIf strDate Like "*-*" And Len(strDate) = 7 Then strDate = Left(strDate, 4) & "-" & Left(strDate, 2) & Right(strDate, 2) ElseIf strDate Like "*-*" And Len(strDate) = 6 Then strDate = Left(strDate, 4) & "-" & Left(strDate, 3) & Right(strDate, 1) End If 'Error capture for the date field. Field should be either null or contain only a four-digit year or a span of 'two four-digit years separated by a hyphen. The first part of the if-else statement converts any date value 'containing a letter of the alphabet, such as "no date," or "November 12, 1978," to a zero, which is then interpreted 'as no date display. The second part converts and date value with an outlier, such as "1941-1945, 1952" to a simple 'date range, "1941-1952." The last two correct for errors such as "1969-75" and "1970-5," converting them 'to "1969-1975" and "1970-1975." Without this correction the date normalization routine can give invalid values to 'the "normal" attribute in the date tag. The date normalization routine could be re-written to also normalize 'specific dates, this would be more complex and require either very consistent date entry or much more sophisticated 'error trapping to deal with inconsistent date entry. 'Debug.Print "strDate after if = " & strDate 'Debug.Print "c0 =" & strC0 & "" 'Chr(13) = Line Break; Chr(9) = Tab; Chr(34) = Double Quote. If intC0 = 1 Then strTab = strDblTab ElseIf intC0 = 2 Then strTab = strDblTab & strDblTab & Chr(9) End If 'Formatting for indented display in XML editor. If intC0 = 1 Then strLevel = "series" strLevel2 = "Series" Else: strLevel = "subseries" strLevel2 = "Sub-Series" End If 'The top level, EAD component level "c01", is tagged as a "Series." All other levels, regardless of how far down 'the hierarchy goes, are tagged as "Sub-Series." If further divisions are desired alter the code: 'ElseIf intC0 = 2 Then 'strLevel = "subseries" 'strLevel2 = "Sub-Series" 'ElseIf intC0 = 3 Then 'strLevel = "subsubseries" 'strLevel2 = "Sub-Sub-Series" 'ElseIf intC0 = 4 Then 'strLevel = "subsubsubseries" 'strLevel2 = "Sub-Sub-Sub-Series" 'End If strAttr = Chr(34) & "deflist" & Chr(34) 'strAttr is just shorthand to cut down a little on typing. If intC0 = 1 Then 'If the EAD component level is c01 and there is no date then the "label" and link "reference" tags are wrapped 'around just the title, with the "item" and "list" tags left open. If the is a date then the date is added after the title. If strDate Like 0 Then strTags2 = Chr(13) & strDblTab & strTab & "<defitem>" strTags2 = strTags2 & Chr(13) & strDblTab & Chr(9) & strTab & "<label><ref linktype=" strTags2 = strTags2 & Chr(34) & "simple" & Chr(34) & " target=" strTags2 = strTags2 & Chr(34) & "link" & intRecIndex & Chr(34) & " show=" strTags2 = strTags2 & Chr(34) & "new" & Chr(34) & " actuate=" strTags2 = strTags2 & Chr(34) & "onrequest" & Chr(34) & ">" strTags2 = strTags2 & strLevel2 & " " & strTitle & "</ref></label>" strTags2 = strTags2 & Chr(13) & strDblTab & Chr(9) & strTab & "<item>" strTags2 = strTags2 & Chr(13) & strDblTab & strDblTab & strTab & "<list type=" & strAttr & ">" Else: strTags2 = strDblTab & strTab & "<defitem>" strTags2 = strTags2 & Chr(13) & strDblTab & Chr(9) & strTab & "<label><ref linktype=" strTags2 = strTags2 & Chr(34) & "simple" & Chr(34) & " target=" strTags2 = strTags2 & Chr(34) & "link" & intRecIndex & Chr(34) & " show=" strTags2 = strTags2 & Chr(34) & "new" & Chr(34) & " actuate=" strTags2 = strTags2 & Chr(34) & "onrequest" & Chr(34) & ">" strTags2 = strTags2 & strLevel2 & " " & strTitle & ", " & strDate & "</ref></label>" strTags2 = strTags2 & Chr(13) & strDblTab & Chr(9) & strTab & "<item>" strTags2 = strTags2 & Chr(13) & strDblTab & strDblTab & strTab & "<list type=" & strAttr & ">" End If Else: 'For EAD component levels other than c01, if there is no date then the "label" and link "reference" tags are wrapped 'around just the title, with the "item" and "list" tags closed. If the is a date then the date is added after the title. If strDate Like 0 Then strTags2 = Chr(13) & strDblTab & strTab & "<defitem>" strTags2 = strTags2 & Chr(13) & strDblTab & Chr(9) & strTab & "<label><ref linktype=" strTags2 = strTags2 & Chr(34) & "simple" & Chr(34) & " target=" strTags2 = strTags2 & Chr(34) & "link" & intRecIndex & Chr(34) & " show=" strTags2 = strTags2 & Chr(34) & "replace" & Chr(34) & " actuate=" strTags2 = strTags2 & Chr(34) & "onrequest" & Chr(34) & ">" strTags2 = strTags2 & strLevel2 & " " & strTitle & "</ref></label>" strTags2 = strTags2 & Chr(13) & strDblTab & Chr(9) & strTab & "<item>" Else: strTags2 = strDblTab & strTab & "<defitem>" strTags2 = strTags2 & Chr(13) & strDblTab & Chr(9) & strTab & "<label><ref linktype=" strTags2 = strTags2 & Chr(34) & "simple" & Chr(34) & " target=" strTags2 = strTags2 & Chr(34) & "link" & intRecIndex & Chr(34) & " show=" strTags2 = strTags2 & Chr(34) & "replace" & Chr(34) & " actuate=" strTags2 = strTags2 & Chr(34) & "onrequest" & Chr(34) & ">" strTags2 = strTags2 & strLevel2 & " " & strTitle & ", " & strDate & "</ref></label>" strTags2 = strTags2 & Chr(13) & strDblTab & Chr(9) & strTab & "<item>" End If End If 'Debug.Print strTags2 rst2.MoveNext If rst2.EOF = False Then 'With the Series and Sub-Series headers constructed as list items in strTags2 the following section opens the "arrangement" 'tag, gives the list a title, and determines what closing tags are needed for each record. intCurrent = intC0 'intCurrent is the EAD component level for the record currently being processed. 'Debug.Print "intCurrent = " & intCurrent intC0 = Nz(rst2!C0, 1) 'Since the cursor has been moved forward one record in the recordset, see "rst2.MoveNext" just above, intC0 is now 'the EAD component level of the next record. 'Debug.Print "intC0 = " & intC0 If intCurrent = 1 Then 'the record being processed has EAD component level c01. If intIndex = 1 Then 'the first record in the recordset needs the "arrangement" tag openned and the list title. 'If the next record has EAD component level c01 the "list," "item," and "defitem" tags are closed, 'otherwise they are left open. If intC0 = 1 Then strTags = Chr(13) & strDblTab & "<arrangement>" & Chr(13) strTags = strTags & strDblTab & strDblTab & "<head>SERIES LIST</head>" & Chr(13) strTags = strTags & strDblTab & Chr(9) & "<list type=" & strAttr & ">" & Chr(13) & strTags2 strClose = "<defitem><label></label><item></item></defitem></list>" strClose = strClose & Chr(13) & strDblTab & strTab & Chr(9) & "<lb/></item>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</defitem>" Else: strTags = Chr(13) & strDblTab & "<arrangement>" & Chr(13) strTags = strTags & strDblTab & Chr(9) & "<head>SERIES LIST</head>" & Chr(13) strTags = strTags & strDblTab & Chr(9) & "<list type=" & strAttr & ">" & Chr(13) & strTags2 strClose = "" End If Else: 'the record is not the first one and so does not need the "arrangement" tag or title. If intC0 = 1 Then strTags = strTags2 strClose = "<defitem><label></label><item></item></defitem></list>" strClose = strClose & Chr(13) & strDblTab & strTab & Chr(9) & "<lb/></item>" strClose = strClose & Chr(13) & strDblTab & strTab & "</defitem>" Else: strTags = strTags2 strClose = "" End If End If ElseIf intCurrent = 2 Then 'the being processed has EAD component level c02. If intC0 = 1 Then 'the next record has EAD component level c01, so the c02 "item," "defitem," and "list" tags 'are closed as are the c01 "item" and "defitem" tags. strTags = strTags2 strClose = "<lb/></item>" strClose = strClose & Chr(13) & strDblTab & strTab & "</defitem>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & "</list>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "<lb/></item>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</defitem>" ElseIf intC0 = 2 Then 'the next record also has EAD component level c02, so only the c02 "item" and "defitem" 'tags are closed. strTags = strTags2 strClose = "<lb/></item>" strClose = strClose & Chr(13) & strDblTab & strTab & "</defitem>" End If End If ElseIf rst2.EOF = True Then 'the record is the last record in the record set, so all tags up through the "arrangement" 'tag are closed and the "description of subordinate components" tag, <dsc>, is openned for the container list and 'the container list is given a title. If intC0 = 1 Then strTags = strTags2 strClose = "<defitem><label></label><item></item></defitem></list>" strClose = strClose & Chr(13) & strDblTab & strTab & Chr(9) & "<lb/></item>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</defitem>" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "</list>" strClose = strClose & Chr(13) & strDblTab & "</arrangement>" strClose = strClose & Chr(13) & strDblTab & "<dsc type=" & Chr(34) & "in-depth" & Chr(34) & ">" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "<head>CONTAINER LIST</head>" ElseIf intC0 = 2 Then strTags = strTags2 strClose = "<lb/></item>" strClose = strClose & Chr(13) & strTab & strDblTab & "</defitem>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & "</list>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "<lb/></item>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</defitem>" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "</list>" strClose = strClose & Chr(13) & strDblTab & "</arrangement>" strClose = strClose & Chr(13) & strDblTab & "<dsc type=" & Chr(34) & "in-depth" & Chr(34) & ">" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "<head>CONTAINER LIST</head>" End If End If 'Debug.Print "strTags = " & strTags 'Debug.Print "strClose = " & strClose strScope = "" 'The scope content note is not included in the arrangement list and so is defined as a zero-length string. DoCmd.RunSQL "INSERT INTO tblEAD VALUES ('" & strTags & "', '" & strScope & "', '" & strClose & "', " & intIndex & ");" 'All data for the record just processed is inserted into tblEAD. intIndex = intIndex + 1 'The index is increased by one, this will keep the records in the proper order. Loop 'return to the beginning of this section of code. Else: 'if there are no Series headers the "description of subordinate components" tag, <dsc>, is openned for the container list and 'the container list is given a title. strScope = "" strTags = Chr(13) & "<dsc type=" & Chr(34) & "in-depth" & Chr(34) & ">" strTags = strTags & Chr(13) & strDblTab & Chr(9) & "<head>CONTAINER LIST" strClose = "</head>" DoCmd.RunSQL "INSERT INTO tblEAD VALUES ('" & strTags & "', '" & strScope & "', '" & strClose & "', " & intIndex & ");" End If rst2.Close Set rst2 = Nothing 'After the first recordset, rst2, has been closed, a new recordset, rst, which contains the data from all the fields in the 'collection table, is openned. rst.Open "Select [Index], [Box]&[BoxModifier] As Box, [Folder]&[FolderT] As Folder, [Title], [ScopeContent], [Date], [C0] FROM " & strTable & " Order By [Index]", CurrentProject.Connection, adOpenStatic rst.MoveFirst Do Until rst.EOF 'Debug.Print rst!Index & " " & rst!Box & " " & rst!Folder & " " & rst!Title & " " & rst!Date intRecIndex = Nz(rst!Index, 0) 'Debug.Print "intRecIndex = " & intRecIndex intIndex = intIndex + 1 'Increases the Index in tblEAD by 1 for each record processed. Enforces order on the table. 'Debug.Print "intIndex = " & intIndex strBox = Nz(rst!Box, "Blank") 'Debug.Print "strBox = " & strBox strFolder = Nz(rst!Folder, 0) 'Debug.Print "strFolder = " & strFolder strTitle = Nz(rst!Title, "") 'Debug.Print "strTitle = " & strTitle intScope = Nz(Len(rst!ScopeContent), 0) 'Debug.Print "intScope = " & intScope strDate = Nz(rst!Date, 0) 'Debug.Print "strDate = " & strDate intC0 = Nz(rst!C0, 1) If strDate Like "*[a-z]*" Then strDate = 0 ElseIf strDate Like "No Date" Then strDate = 0 ElseIf strDate Like "*,*" Then strDate = Left(strDate, 4) & "-" & Right(strDate, 4) strDate = Left(strDate, 4) & "-" & Left(strDate, 2) & Right(strDate, 2) ElseIf strDate Like "*-*" And Len(strDate) = 6 Then strDate = Left(strDate, 4) & "-" & Left(strDate, 3) & Right(strDate, 1) End If 'The "Location Finder" is not currently being used. The purpose of this function was to develop a means of embedding 'the box location in the EAD guide without it being visible to the public. The variable strAddress can be used to place 'the box location in the "container" tag as the value for the "label" attribute.An XSL style sheet can be used to pull 'the box location information from the EAD guide for staff when a patron requests a folder or box from the EAD guide. strAddress = "Location finder off" 'If strBox <> "Blank" Then 'intAddress = Nz(DLookup("[AddressID]", "tblBoxes", "[BoxNumber]&[BoxModifier]= " & strBox & " AND [Collection] = '" & Me!txtColl & "'"), 0) 'Debug.Print "intAddress = " & intAddress 'If intAddress = 0 Then 'strAddress = "No box location" 'Else: 'strAddress = DLookup("[FullAddress]", "tblAddresses", "[ID] = " & intAddress) 'End If 'Debug.Print "strAddress = " & strAddress 'End If 'Debug.Print "c0 =" & intC0 & "" 'Chr(13) = Line Break; Chr(9) = Tab; Chr(34) = Double Quote. If intC0 = 1 Then strTab = strDblTab & Chr(9) ElseIf intC0 = 2 Then strTab = strDblTab & Chr(9) & Chr(9) ElseIf intC0 = 3 Then strTab = strDblTab & Chr(9) & Chr(9) & Chr(9) ElseIf intC0 = 4 Then strTab = strDblTab & Chr(9) & Chr(9) & Chr(9) & Chr(9) ElseIf intC0 = 5 Then strTab = strDblTab & Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) ElseIf intC0 = 6 Then strTab = strDblTab & Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) End If 'strTab is assigned tabs for proper indentation depending on EAD component level. If intScope = 0 Then 'If there is no scope content note for the record the variable strScope is assigned a zero-length string 'as is value. Otherwise its value becomes the scope content note wrapped in the "scopecontent" and "paragraph" tags. strScope = "" Else: strScope = Chr(13) & Chr(9) & strTab & "<scopecontent>" strScope = strScope & Chr(13) & Chr(9) & Chr(9) & strTab & "<p>" & rst!ScopeContent & "</p>" strScope = strScope & Chr(13) & Chr(9) & strTab & "</scopecontent>" End If If strBox Like "Blank" Then 'For any record where there is no box number the "level" attribute in the EAD component level tag is set as "series" if 'the EAD component level is c01, or "subseries" for any other EAD component level. For Series and Sub-Series headers 'the dates are not normalized. The index value from the collection table is used as the value for the "id" attribute 'in the "unittitle" tag, this is completes the link with the same header in the "arrangement" Series List 'constucted previously. The term "Series" or "Sub-Series" is also prefixed to the series title, as appropriate. If intC0 = 1 Then strLevel = "series" strLevel2 = "Series" Else: strLevel = "subseries" strLevel2 = "Sub-Series" End If If strDate Like 0 Then strTags = strTab & "<c0" & intC0 & " [level]=" & Chr(34) & strLevel & Chr(34) & ">" strTags = strTags & Chr(13) & Chr(9) & strTab & "<did>" strTags = strTags & Chr(13) & Chr(9) & Chr(9) & strTab & "<unittitle id=" strTags = strTags & Chr(34) & "link" & intRecIndex & Chr(34) & ">" & strLevel2 & " " strTags = strTags & strTitle & "</unittitle>" strTags = strTags & Chr(13) & Chr(9) & strTab & "</did>" Else: strTags = strTab & "<c0" & intC0 & " [level]=" & Chr(34) & strLevel & Chr(34) & ">" strTags = strTags & Chr(13) & Chr(9) & strTab & "<did>" strTags = strTags & Chr(13) & Chr(9) & Chr(9) & strTab & "<unittitle id=" strTags = strTags & Chr(34) & "link" & intRecIndex & Chr(34) & ">" & strLevel2 & " " strTags = strTags & strTitle & ", " & strDate & "</unittitle>" strTags = strTags & Chr(13) & Chr(9) & strTab & "</did>" End If strClose = "" rst.MoveNext Else: 'Records which are not series headers are all tagged as "file" in the "level" attribute of the EAD component level 'tag, and strTags2 is used to normalize the dates. If Mid(strDate, 5, 1) = "-" Then 'When the date includes a hyphen as the fifth character is an inclusive range 'and is tagged that way: 1976-1979 is tagged as <unitdate type = "inclusive" normal = "1976/1979"> strTags2 = strTab & "<c0" & intC0 & " [level]=" & Chr(34) & "file" & Chr(34) & ">" strTags2 = strTags2 & Chr(13) & Chr(9) & strTab & "<did>" strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<container type=" & Chr(34) & "box" & Chr(34) 'strTags2 = strTags2 & " label=" & Chr(34) & strAddress & Chr(34) strTags2 = strTags2 & ">" & strBox & "</container>" If strFolder Like 0 Then 'If there is no folder container level no <container type = "folder"> tag is included. strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<unittitle>" strTags2 = strTags2 & strTitle & "</unittitle>" strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<unitdate type=" & Chr(34) strTags2 = strTags2 & "inclusive" & Chr(34) & " normal=" & Chr(34) & Left(strDate, 4) strTags2 = strTags2 & "/" & Right(strDate, 4) & Chr(34) & ">" & strDate & "</unitdate>" strTags2 = strTags2 & Chr(13) & Chr(9) & strTab & "</did>" Else: strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<container type=" & Chr(34) strTags2 = strTags2 & "folder" & Chr(34) & ">" & strFolder & "</container>" strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<unittitle>" strTags2 = strTags2 & strTitle & "</unittitle>" strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<unitdate type=" & Chr(34) strTags2 = strTags2 & "inclusive" & Chr(34) & " normal=" & Chr(34) & Left(strDate, 4) strTags2 = strTags2 & "/" & Right(strDate, 4) & Chr(34) & ">" & strDate & "</unitdate>" strTags2 = strTags2 & Chr(13) & Chr(9) & strTab & "</did>" End If ElseIf strDate Like 0 Then 'When there is no date the "unitdate" tags are not included. strTags2 = strTab & "<c0" & intC0 & " [level]=" & Chr(34) & "file" & Chr(34) & ">" strTags2 = strTags2 & Chr(13) & Chr(9) & strTab & "<did>" strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<container type=" & Chr(34) & "box" & Chr(34) 'strTags2 = strTags2 & " label=" & Chr(34) & strAddress & Chr(34) strTags2 = strTags2 & ">" & strBox & "</container>" If strFolder Like 0 Then strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<unittitle>" strTags2 = strTags2 & strTitle & "</unittitle>" strTags2 = strTags2 & Chr(13) & Chr(9) & strTab & "</did>" Else: strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<container type=" & Chr(34) strTags2 = strTags2 & "folder" & Chr(34) & ">" & strFolder & "</container>" strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<unittitle>" strTags2 = strTags2 & strTitle & "</unittitle>" strTags2 = strTags2 & Chr(13) & Chr(9) & strTab & "</did>" End If Else: 'For my finding aids all dates are either inclusive year ranges or single years. For single years 'the year is added as the value for the "level" attribute in the "unitdate" tag. strTags2 = strTab & "<c0" & intC0 & " [level]=" & Chr(34) & "file" & Chr(34) & ">" strTags2 = strTags2 & Chr(13) & Chr(9) & strTab & "<did>" strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<container type=" & Chr(34) & "box" & Chr(34) 'strTags2 = strTags2 & " label=" & Chr(34) & strAddress & Chr(34) strTags2 = strTags2 & ">" & strBox & "</container>" If strFolder Like 0 Then strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<unittitle>" strTags2 = strTags2 & strTitle & "</unittitle>" strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<unitdate normal=" & Chr(34) strTags2 = strTags2 & Right(strDate, 4) & Chr(34) & ">" & strDate & "</unitdate>" strTags2 = strTags2 & Chr(13) & Chr(9) & strTab & "</did>" Else: strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<container type=" & Chr(34) strTags2 = strTags2 & "folder" & Chr(34) & ">" & strFolder & "</container>" strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<unittitle>" strTags2 = strTags2 & strTitle & "</unittitle>" strTags2 = strTags2 & Chr(13) & Chr(9) & Chr(9) & strTab & "<unitdate normal=" & Chr(34) strTags2 = strTags2 & Right(strDate, 4) & Chr(34) & ">" & strDate & "</unitdate>" strTags2 = strTags2 & Chr(13) & Chr(9) & strTab & "</did>" End If End If rst.MoveNext 'The cursor is moved to the next record in the recordset to determine what closing tags are needed. Closing tags up 'through EAD component level c06 are included. If rst.EOF = False Then intCurrent = intC0 intC0 = Nz(rst!C0, 1) If intCurrent = 1 Then If intC0 = 1 Then strTags = strTags2 strClose = Chr(13) & strDblTab & Chr(9) & "</c01>" Else: strTags = strTags2 strClose = "" End If ElseIf intCurrent = 2 Then If intC0 = 1 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & "</c02>" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "</c01>" ElseIf intC0 = 2 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & "</c02>" Else: strTags = strTags2 strClose = "" End If ElseIf intCurrent = 3 Then If intC0 = 1 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</c02>" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "</c01>" ElseIf intC0 = 2 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</c02>" ElseIf intC0 = 3 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" Else: strTags = strTags2 strClose = "" End If ElseIf intCurrent = 4 Then If intC0 = 1 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</c02>" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "</c01>" ElseIf intC0 = 2 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</c02>" ElseIf intC0 = 3 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" ElseIf intC0 = 4 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" Else: strTags = strTags2 strClose = "" End If ElseIf intCurrent = 5 Then If intC0 = 1 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & Chr(9) & "</c05>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</c02>" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "</c01>" ElseIf intC0 = 2 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & Chr(9) & "</c05>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</c02>" ElseIf intC0 = 3 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & Chr(9) & "</c05>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" ElseIf intC0 = 4 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & Chr(9) & "</c05>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" ElseIf intC0 = 4 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & Chr(9) & "</c05>" Else: strTags = strTags2 strClose = "" End If Else: If intC0 = 1 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & strDblTab & "</c06>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & Chr(9) & "</c05>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</c02>" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "</c01>" ElseIf intC0 = 2 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & strDblTab & "</c06>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & Chr(9) & "</c05>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</c02>" ElseIf intC0 = 3 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & strDblTab & "</c06>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & Chr(9) & "</c05>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" ElseIf intC0 = 4 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & strDblTab & "</c06>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & Chr(9) & "</c05>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" ElseIf intC0 = 5 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & strDblTab & "</c06>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & Chr(9) & "</c05>" Else: strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & strDblTab & "</c06>" End If End If ElseIf rst.EOF = True Then 'When the last record in the recordset is reached, EOF, the closing tags for "description of subordinate components," '"archdesc," and "ead" are also included. If intC0 = 1 Then strTags = strTags2 strClose = Chr(13) & strDblTab & Chr(9) & "</c01>" strClose = strClose & Chr(13) & strDblTab & "</dsc>" strClose = strClose & Chr(13) & Chr(9) & "</archdesc>" strClose = strClose & Chr(13) & "</ead>" ElseIf intC0 = 2 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & "</c02>" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "</c01>" strClose = strClose & Chr(13) & strDblTab & "</dsc>" strClose = strClose & Chr(13) & Chr(9) & "</archdesc>" strClose = strClose & Chr(13) & "</ead>" ElseIf intC0 = 3 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</c02>" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "</c01>" strClose = strClose & Chr(13) & strDblTab & "</dsc>" strClose = strClose & Chr(13) & Chr(9) & "</archdesc>" strClose = strClose & Chr(13) & "</ead>" ElseIf intC0 = 4 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</c02>" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "</c01>" strClose = strClose & Chr(13) & strDblTab & "</dsc>" strClose = strClose & Chr(13) & Chr(9) & "</archdesc>" strClose = strClose & Chr(13) & "</ead>" ElseIf intC0 = 5 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & Chr(9) & "</c05>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</c02>" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "</c01>" strClose = strClose & Chr(13) & strDblTab & "</dsc>" strClose = strClose & Chr(13) & Chr(9) & "</archdesc>" strClose = strClose & Chr(13) & "</ead>" ElseIf intC0 = 6 Then strTags = strTags2 strClose = Chr(13) & strDblTab & strDblTab & strDblTab & strDblTab & "</c06>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & Chr(9) & "</c05>" strClose = strClose & Chr(13) & strDblTab & strDblTab & strDblTab & "</c04>" strClose = strClose & Chr(13) & strDblTab & strDblTab & Chr(9) & "</c03>" strClose = strClose & Chr(13) & strDblTab & strDblTab & "</c02>" strClose = strClose & Chr(13) & strDblTab & Chr(9) & "</c01>" strClose = strClose & Chr(13) & strDblTab & "</dsc>" strClose = strClose & Chr(13) & Chr(9) & "</archdesc>" strClose = strClose & Chr(13) & "</ead>" End If End If End If DoCmd.RunSQL "INSERT INTO tblEAD VALUES ('" & strTags & "', '" & strScope & "', '" & strClose & "', " & intIndex & ");" Loop rst.Close Set rst = Nothing DoCmd.Close acTable, " & strTable & " strColl = "L:\kheelstudent\EAD\" & Me!txtColl & ".txt" 'Full path to the directory were the exported text file will be saved. The file is named with the collection number. 'strColl = "C:\Documents and Settings\rm527\Desktop\" & Me!txtColl & ".txt" ''Debug.Print strColl 'Remove the square brackets from around the reserved word "level." DoCmd.RunSQL "UPDATE tblEAD SET Tags = Replace([Tags],'[level]','level');" 'Export the contents of tblEAD to a text file. DoCmd.OutputTo acOutputReport, "rptExport", acFormatTXT, strColl 'Empty tblEAD. DoCmd.RunSQL "DELETE FROM tblEAD;" 'Delete the current "collection number" table, if using dedicated collection tables. DoCmd.RunSQL "DROP TABLE " & strTable & ";" 'If importing data into tblPattern instead of dedicated collection tables comment out the above DoCmd line 'and uncomment the following line to empty tblPattern after the export is complete. 'DoCmd.RunSQL "DELETE FROM tblPattern;" MsgBox "EAD has been exported to " & strColl & "" 'Message box indicating that hte processing is complete. End If DoCmd.SetWarnings True Exit_cmdEAD_Click: Exit Sub Err_cmdEAD_Click: DoCmd.SetWarnings True MsgBox Err.Description Resume Exit_cmdEAD_Click End Sub Private Sub cmdImport_Click() On Error GoTo Err_cmdImport_Click DoCmd.SetWarnings False Dim strColl As String Dim strSQL As String strColl = "[" & Me!txtColl & "]" 'Debug.Print "strColl = " & strColl 'Check for a collection number in the text box. If not request user to enter one. If strColl = "[]" Then MsgBox "Please enter a collection number in the text box." Else: strSQL = "SELECT tblPattern.Index, tblPattern.Accession, tblPattern.Box, " strSQL = strSQL & "tblPattern.BoxModifier, tblPattern.Folder, tblPattern.FolderT, tblPattern.Title, " strSQL = strSQL & "tblPattern.Date, tblPattern.ScopeContent, tblPattern.C0 " strSQL = strSQL & "INTO " & strColl & " FROM tblPattern;" 'The above SQL statement will create a new table, using the collection number as the table name, 'that is identical to tblPattern. If you wish to import the data into tblPattern instead of using dedicated tables 'for each colleciton, simply comment out the line DoCmd.RunSQL strSQL. In SUB cmdEAD comment out the line 'DoCmd.RunSQL "DROP TABLE " & strTable & ";" which is intended to drop the collection table from the database, 'and uncomment the line DoCmd.RunSQL "DROP DELETE FROM tblPattern;" in order to clear the data from tblPattern 'when it is no longer need. 'When the import dialog box opens select tblPattern. DoCmd.RunSQL strSQL DoCmd.RunCommand acCmdImportAttachExcel 'Opens the dialog box for importing an Excel spreadsheet. Browse to the Excel file and choose "Append copy of the 'records to the table [collection number]. End If DoCmd.SetWarnings True Exit_cmdImport_Click: Exit Sub Err_cmdImport_Click: DoCmd.SetWarnings True MsgBox Err.Description Resume Exit_cmdImport_Click End Sub