'MacroName:Enhance505 'MacroDescription:Add enhanced subfield codes to unenhanced 505 fields 'Macro created by: Joel Hahn, Niles Public Library District 'Subfield processing modified 10 Mar 2005 to handle the same exceptional cases as a similar macro by John Lavalie, Des Plaines Public Library 'Last modified: 21 Mar 2005 '$Include "NikAdds!IncludeFunctions" Sub Main Dim CS As Object On Error Resume Next Set CS = GetObject(,"Connex.Client") On Error GoTo 0 If CS Is Nothing Then Set CS = CreateObject("Connex.Client") End If bool = IsBibRecord(CS) If bool = FALSE Then MsgBox "The active window is not a bibliographic record. Exiting..." Exit Sub End If bool = CS.GetField("505", 1, sData) If bool = FALSE Then MsgBox "There are no 505 fields in the current record. Exiting..." Exit Sub End If sStmtResp = "with ,feat.,duet " sClassicalWork = "KK ,HVW,BWV" sPartsData = "Disc ,disc ,Tape ,tape ,Cassette ,cassette ,CD ,Part ,Pt. , pt. ,Vol. , vol. ,V. ,v. " i% = 1 Do 'MsgBox sData If Mid(sData, 5, 1) = " " Then place2 = InStr(6, sData, " ") If (InStr(sPartsData, Mid(sData, 6, place2 - 5)) And Mid(sData, place2 + 1, 1) Like "[0-9]") Then sData = Left(sData, 5) & Chr(223) & "g " & Mid(sData, 6) place3 = InStr(place2 + 4, sData, " ") sData = Left(sData, place3) & Chr(223) & "t " & Mid(sData, place3 + 1) ElseIf Mid(sData, 6, place2 - 5) Like "[0-9]*. " Then sData = Left(sData, 5) & Chr(223) & "g " & Mid(sData, 6) sData = Left(sData, place2 + 3) & Chr(223) & "t " & Mid(sData, place2 + 4) Else sData = Left(sData, 5) & Chr(223) & "t " & Mid(sData, 6) End If place = 0 Do While InStr(place + 1, sData, "--.") place = InStr(place + 1, sData, "--.") sData = Left(sData, place - 1) & " -- " & Mid(sData, place + 4) Loop place = 0 Do While InStr(place + 1, sData, " -- ") place = InStr(place + 1, sData, " -- ") place2 = InStr(place + 4, sData, " ") If place2 > 0 Then If (InStr(sPartsData, Mid(sData, place + 4, place2 - (place + 4) + 1)) And (Mid(sData, place2 + 1, 1) Like "[0-9]")) Then sData = Left(sData, place + 2) & " " & Chr(223) & "g " & Mid(sData, place + 4) place3 = InStr(place2 + 4, sData, " ") sData = Left(sData, place3) & Chr(223) & "t " & Mid(sData, place3 + 1) ElseIf Mid(sData, place + 4, place2 - (place + 4) + 1) Like "[0-9]*. " Then sData = Left(sData, place + 2) & " " & Chr(223) & "g " & Mid(sData, place + 4) sData = Left(sData, place2 + 3) & Chr(223) & "t " & Mid(sData, place2 + 4) Else sData = Left(sData, place + 2) & " " & Chr(223) & "t " & Mid(sData, place + 4) End If Else sData = Left(sData, place + 2) & " " & Chr(223) & "t " & Mid(sData, place + 4) End If Loop place = 0 Do While InStr(place + 1, sData, " = ") place = InStr(place + 1, sData, " = ") sData = Left(sData, place + 1) & " " & Chr(223) & "t " & Mid(sData, place + 3) Loop place = 0 Do While InStr(place + 1, sData, " / ") place = InStr(place + 1, sData, " / ") sData = Left(sData, place + 1) & " " & Chr(223) & "r " & Mid(sData, place + 3) Loop place = -3 Do While InStr(place + 4, sData, " (") place = InStr(place + 4, sData, " (") If Mid(sData, place - 2, 2) <> Chr(223) & "t" Then 'Don't proceed if title begins with parentheses If Mid(sData, place + 2, 1) = ":" Then 'Parentheses contain a time of less than 1 minute) sData = Left(sData, place) & Chr(223) & "g " & Mid(sData, place + 1) ElseIf Mid(sData, place + 2, 1) Like "[0-9]" Then place2 = InStr(place, sData, ")") TimeTest$ = Mid(sData, place + 1, place2 - (place + 1)) If InStr(TimeTest$, ":") Then 'Parentheses contain a time sData = Left(sData, place) & Chr(223) & "g " & Mid(sData, place + 1) Else 'Parentheses contain non-time numeric data; probably the name of a performing group PrevSubfield = EnumPrevSubfield(sData, place) If PrevSubfield <> Chr(223) & "r" Then NextSubfield = EnumNextSubfield(sData, place) If NextSubfield <> Chr(223) & "r" Then sData = Left(sData, place) & Chr(223) & "r " & Mid(sData, place + 1) End If End If End If Else If InStr(sClassicalWork, Mid(sData, place + 2, 3)) Then 'Parentheses contain classical numbering scheme that is part of the title; do nothing. ElseIf InStr(sStmtResp, Mid(sData, place + 2, 5)) Then 'Parentheses contain a statement of responsibility; mark only if not already in a $r subfield. If PrevSubfield <> Chr(223) & "r" Then sData = Left(sData, place) & Chr(223) & "r " & Mid(sData, place + 1) End If Else PrevSubfield = EnumPrevSubfield(sData, place) If PrevSubfield <> Chr(223) & "r" and Mid(sData, place + 2, 1) Like "[A-Z]" Then NextSubfield = EnumNextSubfield(sData, place) If NextSubfield <> Chr(223) & "r" Then place2 = InStr(place, sData, ")") If Mid(sData, place2 + 2, 1) = "(" and Mid(sData, place2 + 3, 1) Like "[A-Z]" Then 'Parentheses are followed by a second set of parentheses with non-numeric data 'Thus first set probably contains title data; but only tag it if it isn't already in a $t subfield If PrevSubfield <> Chr(223) & "t" Then sData = Left(sData, place) & Chr(223) & "t " & Mid(sData, place + 1) End If Else sData = Left(sData, place) & Chr(223) & "r " & Mid(sData, place + 1) End If End If End If End If End If End If Loop place = 0 Do While InStr(place + 1, sData, " ; ") place = InStr(place + 1, sData, " ; ") PrevSubfield = EnumPrevSubfield(sData, place) If PrevSubfield = Chr(223) & "t" Or PrevSubfield = Chr(223) & "g" Then sData = Left(sData, place + 1) & " " & Chr(223) & "t " & Mid(sData, place + 3) End If Loop Mid(sData, 5, 1) = "0" bool = CS.SetField(i%, sData) If bool = FALSE Then MsgBox "SetField Failed. Exiting..." Exit Do End If End If i% = i% + 1 IsField = CS.GetField("505", i%, sData) Loop While IsField <> FALSE 'MsgBox "Done!" & Chr(10) & Chr(10) & "Make sure to double-check the subfields added by the macro before performing final actions on the record." End Sub