'MacroName:505to700 'MacroDescription:creates 700s from 505r 'written by John Lavalie, July 3, 2006 option explicit option compare text '-------------------- function replace(strString as string, strOld as string, strNew as string) as string dim pos as integer pos = instr(strString, strOld) do while pos > 0 strString = left(strString, pos - 1) & strNew & mid(strString, pos + len(strOld)) pos = instr(strString, strOld) loop replace = strString end function '------------------- function Make710(heading as string, needsQualifier as string) as string dim temp$ heading = replace(heading, "&", "") heading = trim(heading) if right(heading, 10) = "production" then heading = trim(replace(heading, "production", "")) if instr(heading, "presented by") > 0 then heading = trim(replace(heading, "presented by", "")) if left(heading, 2) = "a " then heading = mid(heading, 3) if left(heading, 3) = "an " then heading = mid(heading, 4) if left(heading, 4) = "the " then heading = mid(heading, 5) temp$ = "7102 " & trim(heading) if needsQualifier = "TRUE" then temp$ = temp$ & " (Musical group)" else temp$ = temp$ & "." end if Make710 = temp$ end function '------------------- function Make700(heading as string) as string dim split, x as integer dim firstName, lastName as string heading = trim(heading) x = len(heading) do if mid(heading, x, 1) = " " then split = x x = x - 1 loop until x = 1 or split <> 0 if split <> 0 then firstName = trim(left(heading, split)) lastName = trim(mid(heading, split)) else firstName = heading lastName = "" end if 'two first initials if right(firstName, 4) like "[A-Z].[A-Z]." then firstName = left(firstName, len(firstName) - 2) & " " & right(firstName, 2) end if 'put back suffix if instr(lastName, "~Jr.") > 0 then firstName = firstName & ", " & chr(223) & "c Jr" lastName = replace(lastName, "~Jr.", "") elseif instr(lastName, "~Sr.") > 0 then firstName = firstName & ", " & chr(223) & "c Sr" lastName = replace(lastName, "~Sr.", "") end if if lastName = "" then heading = "7001 " & firstName else heading = "7001 " & lastName & ", " & firstName end if if right(heading, 1) <> "." then heading = heading & "." Make700 = heading end function '--------------------- function CountBlanks(str as string) as integer dim i%, count% for i% = 1 to len(str) if mid(str, i%, 1) = " " then count% = count% + 1 next CountBlanks = count% end function '--------------------- function firstInitial(heading as string) as integer dim x as integer firstInitial = 0 for x = 1 to len(heading) - 4 if mid(heading, x, 4) like " [A-Z]. " then firstInitial = x next end function '--------------------- function isGroup(heading as string) as integer dim groups$(50), x% isGroup = FALSE groups$(0) = "orchestra" : groups$(1) = "chorus" : groups$(2) = "group" groups$(3) = "duo" : groups$(4) = "trio" : groups$(5) = "quartet" groups$(6) = "quintet" : groups$(7) = "septet" : groups$(8) = "sextet" groups$(9) = "octet" : groups$(10) = "nonet" : groups$(11) = "grupo" groups$(12) = "band" : groups$(13) = "brothers" : groups$(14) = "sisters" groups$(15) = "girls" : groups$(16) = "girlz" : groups$(17) = "boys" groups$(18) = "boyz" : groups$(19) = "singers" : groups$(20) = "musical" groups$(21) = "banda" : groups$(22) = "choir" : groups$(23) = "corporation" groups$(24) = "project" : groups$(25) = "organization" x% = 0 do while groups$(x%) <> "" if instr(heading, groups$(x%)) then isGroup = TRUE x% = x% + 1 loop end function '--------------------- Sub Main dim bool, Dup dim tag505$, delim$ dim pos%, pipe%, nr505s%, i%, j% dim nrNames%, nrHeadings%, nrBlanks% dim Names$(100), Headings$(100) dim CS As Object Set CS = CreateObject("Connex.Client") CS.Reformat delim$ = chr(223) nr505s% = 1 bool = CS.GetField ("505", nr505s%, tag505$) do until bool = FALSE if mid(tag505$, 5, 1) <> "0" then CS.RunMacro "NikAdds!Joels505" 'MsgBox "Contents note is not enhanced.", 0, "Error" 'exit sub end if tag505$ = mid(tag505$, 8) tag505$ = replace(tag505$, ", Jr.", "~Jr.") tag505$ = replace(tag505$, ", Sr.", "~Sr.") tag505$ = replace(tag505$, delim$ & "t", "|") tag505$ = replace(tag505$, delim$ & "g", "|") tag505$ = replace(tag505$, " -- ", "") tag505$ = replace(tag505$, " ; ", "") if right(tag505$, 1) = "." then tag505$ = left(tag505$, len(tag505$) - 1) tag505$ = tag505$ & "|" pos% = instr(tag505$, delim$ & "r") do until pos% = 0 pipe% = instr(pos%, tag505$, "|") Names$(nrNames%) = mid(tag505$, pos% + 2, pipe% - pos% - 2) nrNames% = nrNames% + 1 pos% = instr(pipe%, tag505$, delim$ & "r") loop nrNames% = nrNames% - 1 'first split for i% = 0 to nrNames% Names$(i%) = trim(Names$(i%)) Names$(i%) = replace(Names$(i%), "featuring", "|") Names$(i%) = replace(Names$(i%), "feat.", "|") Names$(i%) = replace(Names$(i%), " with ", "|") Names$(i%) = replace(Names$(i%), "(with ", "|") Names$(i%) = replace(Names$(i%), " con ", "|") Names$(i%) = replace(Names$(i%), "(con ", "") Names$(i%) = replace(Names$(i%), " y ", "|") Names$(i%) = replace(Names$(i%), "(y ", "") Names$(i%) = replace(Names$(i%), delim$ & "r with ", "") Names$(i%) = replace(Names$(i%), delim$ & "r con ", "") Names$(i%) = replace(Names$(i%), " and his orchestra", "") Names$(i%) = replace(Names$(i%), " and his ", "|") Names$(i%) = replace(Names$(i%), " and friends ", "") Names$(i%) = replace(Names$(i%), " & friends ", "") Names$(i%) = replace(Names$(i%), " and ", "|") Names$(i%) = replace(Names$(i%), " & ", "|") Names$(i%) = replace(Names$(i%), ", ", "|") if left(Names$(i%), 1) = "(" then Names$(i%) = mid(Names$(i%), 2) if right(Names$(i%), 1) = ")" then Names$(i%) = left(Names$(i%), len(Names$(i%)) - 1) next 'second split for i% = 0 to nrNames% pos% = instr(Names$(i%), "|") do if pos% > 0 then Headings$(nrHeadings%) = trim(left(Names$(i%), pos% - 1)) nrHeadings% = nrHeadings% + 1 Names$(i%) = trim(mid(Names$(i%), pos% + 1)) else Headings$(nrHeadings%) = trim(Names$(i%)) nrHeadings% = nrHeadings% + 1 Names$(i%) = "" end if pos% = instr(Names$(i%), "|") loop until pos% = 0 and Names$(i%) = "" next nrHeadings% = nrHeadings% + 1 nrNames% = 0 'check for dups for i% = 0 to nrHeadings% Dup = FALSE for j% = 0 to nrNames% if Names$(j%) = Headings$(i%) then Dup = TRUE next j% if Dup = FALSE then Names$(nrNames%) = Headings$(i%) nrNames% = nrNames% + 1 end if next i% nrHeadings% = 0 nrNames% = nrNames% - 1 nr505s% = nr505s% + 1 bool = CS.GetField ("505", nr505s%, tag505$) loop '700 or 710? for i% = 0 to nrNames% if isGroup(Names$(i%)) then Names$(i%) = Make710(Names$(i%), "FALSE") else nrBlanks% = CountBlanks(Names$(i%)) 'more than one blank *probably* means 710 if nrBlanks% = 2 then pos = firstInitial(Names$(i%)) if pos > 0 then 'except for single middle initial Names$(i%) = Make700(Names$(i%)) else Names$(i%) = Make710(Names$(i%), "TRUE") end if else if left(Names$(i%), 2) = "a " or left(Names$(i%), 3) = "an " or left(Names$(i%), 4) = "the " or nrBlanks% > 1 then Names$(i%) = Make710(Names$(i%), "TRUE") elseif left (Names$(i%), 3) = "DJ " or left (Names$(i%), 3) = "MC " then Names$(i%) = "7000 " & Names$(i%) & "." Names$(i%) = replace(Names$(i%), "..", ".") else Names$(i%) = Make700(Names$(i%)) end if end if end if CS.AddFieldLine 99, Names$(i%) & " " & delim$ & "4 prf" next end sub