Запись строк в файл

Option Explicit
 
Private Sub Command1_Click()
Dim TextLine As String
Dim B As String
 
B = InputBox("Введите букву", "", "Н")
 
 Open App.Path & "\1.txt" For Input As #1
 Open App.Path & "\2.txt" For Output As #2
 Do While Not EOF(1)
        Line Input #1, TextLine ' Читает строку в переменную.
        If Left(TextLine, 1) = B Then ' если первая буква совпадает
            Print #2, TextLine ' печатаем в файл
        End If
 Loop
 Close
  End Sub

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