'MacroName:AddCommon33X 'MacroDescription:Add common 33X fields in a bibliographic or authority record via a menu 'Macro written by: Joel Hahn, Niles Public Library District 'Macro last updated: 9 July 2012 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 Dim arrSelect(0 To 13) As String Dim arr336(0 To 13) As String Dim arr337(0 To 13) As String Dim arr338(0 To 13) As String arrSelect(0) = "Book" arrSelect(1) = "Braille book" arrSelect(2) = "Online e-book" arrSelect(3) = "Videogame cartridge" arrSelect(4) = "Videogame disc" arrSelect(5) = "Road map" arrSelect(6) = "Music CD" arrSelect(7) = "Online e-audiobook" arrSelect(8) = "Spoken word CD" arrSelect(9) = "Bound music score" arrSelect(10) = "Blu-ray" arrSelect(11) = "Blu-ray 3D" arrSelect(12) = "DVD" arrSelect(13) = "Online e-video" arr336(0) = "text " & Chr(223) & "b txt " & Chr(223) & "2 rdacontent" arr336(1) = "tactile text " & Chr(223) & "b tct " & Chr(223) & "2 rdacontent" arr336(2) = "text " & Chr(223) & "b txt " & Chr(223) & "2 rdacontent" arr336(3) = "computer program " & Chr(223) & "b cop " & Chr(223) & "2 rdacontent" arr336(4) = "computer program " & Chr(223) & "b cop " & Chr(223) & "2 rdacontent" arr336(5) = "cartographic image " & Chr(223) & "b cri " & Chr(223) & "2 rdacontent" arr336(6) = "performed music " & Chr(223) & "b prm " & Chr(223) & "2 rdacontent" arr336(7) = "spoken word " & Chr(223) & "b spw " & Chr(223) & "2 rdacontent" arr336(8) = "spoken word " & Chr(223) & "b spw " & Chr(223) & "2 rdacontent" arr336(9) = "notated music " & Chr(223) & "b ntm " & Chr(223) & "2 rdacontent" arr336(10) = "two-dimensional moving image " & Chr(223) & "b tdi " & Chr(223) & "2 rdacontent" arr336(11) = "three-dimensional moving image " & Chr(223) & "b tdm " & Chr(223) & "2 rdacontent" arr336(12) = "two-dimensional moving image " & Chr(223) & "b tdi " & Chr(223) & "2 rdacontent" arr336(13) = "two-dimensional moving image " & Chr(223) & "b tdi " & Chr(223) & "2 rdacontent" arr337(0) = "unmediated " & Chr(223) & "b n " & Chr(223) & "2 rdamedia" arr337(1) = "unmediated " & Chr(223) & "b n " & Chr(223) & "2 rdamedia" arr337(2) = "computer " & Chr(223) & "b c " & Chr(223) & "2 rdamedia" arr337(3) = "computer " & Chr(223) & "b c " & Chr(223) & "2 rdamedia" arr337(4) = "computer " & Chr(223) & "b c " & Chr(223) & "2 rdamedia" arr337(5) = "unmediated " & Chr(223) & "b n " & Chr(223) & "2 rdamedia" arr337(6) = "audio " & Chr(223) & "b s " & Chr(223) & "2 rdamedia" arr337(7) = "computer " & Chr(223) & "b c " & Chr(223) & "2 rdamedia" arr337(8) = "audio " & Chr(223) & "b s " & Chr(223) & "2 rdamedia" arr337(9) = "unmediated " & Chr(223) & "b n " & Chr(223) & "2 rdamedia" arr337(10) = "video " & Chr(223) & "b v " & Chr(223) & "2 rdamedia" arr337(11) = "video " & Chr(223) & "b v " & Chr(223) & "2 rdamedia" arr337(12) = "video " & Chr(223) & "b v " & Chr(223) & "2 rdamedia" arr337(13) = "computer " & Chr(223) & "b c " & Chr(223) & "2 rdamedia" arr338(0) = "volume " & Chr(223) & "b nc " & Chr(223) & "2 rdacarrier" arr338(1) = "volume " & Chr(223) & "b nc " & Chr(223) & "2 rdacarrier" arr338(2) = "online resource " & Chr(223) & "b cr " & Chr(223) & "2 rdacarrier" arr338(3) = "computer chip cartridge " & Chr(223) & "b cb " & Chr(223) & "2 rdacarrier" arr338(4) = "computer disc " & Chr(223) & "b cd " & Chr(223) & "2 rdacarrier" arr338(5) = "sheet " & Chr(223) & "b nb " & Chr(223) & "2 rdacarrier" arr338(6) = "audio disc " & Chr(223) & "b sd " & Chr(223) & "2 rdacarrier" arr338(7) = "online resource " & Chr(223) & "b cr " & Chr(223) & "2 rdacarrier" arr338(8) = "audio disc " & Chr(223) & "b sd " & Chr(223) & "2 rdacarrier" arr338(9) = "volume " & Chr(223) & "b nc " & Chr(223) & "2 rdacarrier" arr338(10) = "videodisc " & Chr(223) & "b vd " & Chr(223) & "2 rdacarrier" arr338(11) = "videodisc " & Chr(223) & "b vd " & Chr(223) & "2 rdacarrier" arr338(12) = "videodisc " & Chr(223) & "b vd " & Chr(223) & "2 rdacarrier" arr338(13) = "online resource " & Chr(223) & "b cr " & Chr(223) & "2 rdacarrier" Begin Dialog newdlg 186, 147 Text 4, 1, 46, 10, "Select format:" ListBox 3, 15, 120, 130, arrSelect(), .Format OkButton 127, 25, 50, 14 CancelButton 129, 44, 50, 14 End Dialog Dim SelectFormat As newdlg retval = Dialog(SelectFormat) If retval = 0 Then Exit Sub 'Cancel button retval = CS.AddField(1, "336 " & arr336(SelectFormat.Format)) retval = CS.AddField(1, "337 " & arr337(SelectFormat.Format)) retval = CS.AddField(1, "338 " & arr338(SelectFormat.Format)) End Sub