' MacroName: HoldingsReport ' MacroDescription: Create a list of items the library owns, based on a call number search ' Written by: Joel Hahn, Niles Public Library District sub main Dim CS as Session Set CS = CurrentSession Dim nTimeOut as Integer nTimeOut = 30 Begin Dialog InfoDialog 58, 54, 186, 92 GroupBox 2, 0, 61, 89, "Format" OptionGroup .Format OptionButton 6, 8, 56, 9, "Videocassette", .VHS OptionButton 6, 20, 25, 9, "DVD", .DVD OptionButton 6, 31, 19, 9, "CD", .CD OptionButton 6, 43, 38, 9, "Cassette", .Cass OptionButton 6, 54, 56, 9, "Book on Tape", .BOT OptionButton 6, 66, 47, 9, "Book on CD", .BOCD OptionButton 6, 77, 37, 9, "CD-ROM", .CDROM GroupBox 65, 0, 43, 35, "Level" OptionGroup .Level OptionButton 69, 8, 27, 9, "Adult", .Adult OptionButton 69, 20, 37, 9, "Juvenile", .Juv GroupBox 66, 35, 43, 32, "Output" OptionGroup .Output OptionButton 69, 43, 25, 9, "Text", .Text OptionButton 69, 54, 30, 9, "HTML", .HTML OkButton 130, 6, 50, 14 CancelButton 130, 23, 50, 14 End Dialog Dim Info as InfoDialog Info.Format=0 Info.Level=0 Info.Output=1 z = Dialog(Info) If z = 0 Then Goto Done a%=Info.Format b%=Info.Level c%=Info.Output CS.Send Chr(1)+"A" CS.Receive nTimeOut, "" CS.Send "12" CS.Receive nTimeOut, "[?25h" CS.Send Chr(27)+"[A" + Chr(27)+"[A" Search$="" FNF=0 If Info.Level=1 Then Search$="J/" Select Case Info.Format Case 0 Search$=Search$+"VIDEO$" AVFormat$="VID" TitleFormat$="Videocassette" FNF=1 Case 1 Search$=Search$+"DVD$" AVFormat$="DVD" TitleFormat$="DVD" Case 2 Search$=Search$+"CD/$" AVFormat$="CDS" TitleFormat$="Compact Disc" Case 3 Search$=Search$+"CASS$" AVFormat$="CAS" TitleFormat$="Cassette" Case 4 Search$=Search$+"BOOK ON TAPE$" AVFormat$="BOT" TitleFormat$="Books on Tape" Case 5 Search$=Search$+"BOOK ON CD$" AVFormat$="BOC" TitleFormat$="Books on CD" Case 6 Search$=Search$+"CD-ROM$" AVFormat$="CDR" TitleFormat$="CD-ROM" End Select If Info.Level=1 then AVFormat$="J"+AVFormat$ TitleFormat$="Juvenile "+TitleFormat$ End If Today$=Left(Date$,2)+Mid(Date$,4,2) '+Right(Date$,4) Select Case Info.Output Case 0 Filename$="C:\MyDocu~1\"+AVFormat$+".txt" '+Today$+".txt" If FNF=1 Then Filename2$="C:\MyDocu~1\"+AVFormat$+"nf.txt" '+Today$+".txt" End If Case 1 Filename$="C:\MyDocu~1\"+AVFormat$+".htm" '+Today$+".htm" If FNF=1 Then Filename2$="C:\MyDocu~1\"+AVFormat$+"nf.htm" '+Today$+".htm" End If End Select CS.Send Search$+Chr(13) CS.Receive 360, "" CS.GetTextInRegion ScnText, 2, 65, 2, 80 place=InStr(ScnText, " of ") j=1 Do while j<=place If Mid(ScnText, j, 1) Like "[0-9]" Then place2=j Exit Do End If j=j+1 Loop CurrRec=Val(Mid(ScnText, place2, place-place2)) EndRec=Val(Mid(ScnText, place+3, Len(ScnText)-place-2)) total=EndRec-CurrRec If Info.Output=1 Then Filenum%=FreeFile Open Filename$ for Output as Filenum% Print #filenum%, ""+TitleFormat$+" Holdings" Print #filenum%, "" Print #filenum%, ""+TitleFormat$+" Holdings
" Print #filenum%, "As of "+Date$+"" Print #filenum%, Print #filenum%, "


" Close Filenum% If FNF=1 Then Filenum%=FreeFile Open Filename2$ for Output as Filenum% Print #filenum%, ""+TitleFormat$+" Holdings" Print #filenum%, "" Print #filenum%, "Non-Fiction "+TitleFormat$+" Holdings
" Print #filenum%, "As of "+Date$+"" Print #filenum%, Print #filenum%, "


" Close Filenum% End If End If curr=0 Do CS.GetTextInRegion CallNum$, 10, 20, 10, 67 CallNum$=Trim(CallNum$) CS.GetTextInRegion Scat$, 11, 58, 11, 62 Scat$=Trim(Scat$) If Info.Level=0 And Left(CallNum$, 2)="J/" Then Goto Looper If Info.Format=2 and Left(CallNum$, 6)="CD-ROM" Then Goto Looper If Info.Format=2 and Info.Level=1 and Left(CallNum$, 8)="J/CD-ROM" Then Goto Looper CS.GetTextInRegion AuthorTitle$, 6, 3, 6, 78 place=InStr(AuthorTitle$, "/") If place=27 Then Author$=Trim(Left(AuthorTitle$, place-1)) Title$=Trim(Right(AuthorTitle$, Len(AuthorTitle$)-place-1)) If Right(Title$, 1)=":" Then Title$=Left(Title$, Len(Title$)-1) Else Title$=Trim(Right(AuthorTitle$, Len(AuthorTitle$)-place-1)) If Right(Title$, 1)=":" Then Title$=Left(Title$, Len(Title$)-1) Title$=Title$+" / "+Trim(Left(AuthorTitle$, place-1)) 'CS.Send Chr(13) 'CS.Send Chr(1)+"G" 'CS.Receive nTimeOut%, "[?25h" '"A/T Key:" 'CS.GetTextInRegion AT2$, 10, 2, 13, 77 'place=InStr(1, AT2$, "V. AUTHOR") 'If place>0 Then ' Author$=Trim(Mid(AT2$, place+19, 56)) 'End If 'place=InStr(1, AT2$, "V. TITLE") 'If place>0 Then ' Title$=Trim(Mid(AT2$, place+19, 56)) ' CS.GetTextInRegion T2$, 6, 25, 6, 78 ' Title$=Trim(T2$)+" / "+Title$ 'Else ' CS.GetTextInRegion T2$, 6, 25, 6, 78 ' Title$=Trim(T2$) 'End If 'CS.Send Chr(1)+"C" 'CS.Receive nTimeOut%, "" '"[?25h" '"A/T Key:" 'CS.Send Chr(1)+"f" 'Chr(13) End If 'CS.GetTextInRegion Author$, 6, 3, 6, 28 'Author$=Trim(Author$) 'If Left(Author$,1) Like "[0-9]" Then ' place=InStr(1, Author$, " ") ' If place<>0 Then ' Author$=Trim(Right(Author$, Len(Author$)-place-1)) ' Else ' Author$="" ' End If 'End If 'CS.GetTextInRegion Title$, 6, 30, 6, 78 'Title$=Trim(Title$) 'If Left(Title$,1)="/" Then ' Title$=Right(Title$, Len(Title$)-2) 'End If '***** 'Routine to add info to file 'MsgBox Author$+Chr(10)+Title$+Chr(10)+CallNum$ 'Filename$="C:\"+AVFormat$+Today$+".txt" NFScat$=",22,238,239," Filenum%=FreeFile If Info.Format=0 and (InStr(1,NFScat$, ","+Scat$+",")>0) Then Open Filename2$ for Append as Filenum% Else Open Filename$ for Append as Filenum% End If Select Case Info.Output Case 0 Print #filenum%, Title$ If Author$<>"" Then Print #filenum%, "Author: "+Author$ End If Print #filenum%, "Call Number: "+CallNum$ Print #filenum%, Case 1 Print #filenum%, "

"+Title$+"
" If Author$<>"" Then Print #filenum%, "Author: "+Author$+"
" End If Print #filenum%, "Call Number: "+CallNum$+"" Print #filenum%, End Select Close Filenum% '***** Looper: If curr


" Print #filenum%, "finis" Print #filenum%, "" Print #filenum%, "" Close Filenum% If FNF=1 Then Filenum%=FreeFile Open Filename2$ for Append as Filenum% Print #filenum%, "


" Print #filenum%, "finis" Print #filenum%, "" Print #filenum%, "" Close Filenum% End If End If MsgBox "Done" Done: end sub