Автоматизировать механизм поиска учебников по заданным кодам наименований дисциплин

Option Explicit
Dim dic As Object
Dim fso As Object
'-------------------------------
Const lenkey& = 32
Dim key As String * lenkey, fn$
 
Public Function WriteRec&(Path$, num&, rec$)
    key = rec
    Open Path For Random As #1
    If num Then Else num = 1
    Put #1, num, key
    WriteRec = num + lenkey
    Close #1
End Function
 
Public Function ReadRec(Path$, num&) As String
    Open Path For Random As #1
    Get #1, num, key
    ReadRec = key
    Close #1
End Function
 
Private Sub Form_Load()
    Dim s$, n&, rec$
    s = InputBox("введите книгу", , "Тургенев-МуМу")
    n = dic(s)
    If n > 0 Then
        rec = ReadRec(fn, n)
        MsgBox "Номер в базе =" & CStr(n)
    End If
End Sub
 
Private Sub Form_Initialize()
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1 'TextCompare
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim s$, j$(), f&
    s = "Толстой-Война и мир//Тургенев-МуМу//Бонч-Бруевич -Тайная переписка"
    fn = Environ("homedrive") & Environ("homepath") & "\MyBase.txt"
    j = Split(s, "//")
    For f = 0 To UBound(j)
        WriteRec fn, f + 1, j(f)
        dic.Add j(f), f + 1
    Next
End Sub