Private Function GetFilePath() As Variant
    Dim tmpString As Variant
    tmpString = Application.GetOpenFilename _
    ("Text Files(*.txt;*.dat;*.ini), *.txt;*.dat;*.ini, All files(*.*), *.*", 1, "Select some file for read data")
    GetFilePath = tmpString
End Function
Sub RtxtFile()
    Dim tmpString As Variant, Ff As Integer, strRes As String
    tmpString = GetFilePath
    If tmpString = False Then Exit Sub
    Ff = FreeFile(0)
    
    'Открываем файл в режиме чтения из него, если такого файла не существует, то он будет ОШИБКА!
    Open tmpString For Input As #Ff
    Do While Not EOF(Ff) 'Пока не достигнем конца файла
        Line Input #Ff, tmpString 'Чтение строки файла в переменную
        strRes = strRes & tmpString & vbNewLine
    Loop
    Close #Ff 'закрываем файл
    Dim t As String: t = Replace(Left(strRes, Len(strRes) - 2), Chr(34), ""): MsgBox t 'Val(t) * 3 ' Проба цифр
End Sub
Sub WtxtFile()
    Dim tmpString As Variant, Ff As Integer, Cell As Range, strRes As String, ws As Object
    tmpString = GetFilePath
    If tmpString = False Then Exit Sub
    Ff = FreeFile(0)
    
    'Открываем файл в режиме записи (в него), если такого файла не существует, то он будет СОЗДАН!
    Open tmpString For Output As #Ff
    For Each Cell In ActiveCell.CurrentRegion
        strRes = strRes & Cell.Text & " "
    Next Cell
    Write #Ff, Application.WorksheetFunction.Trim(strRes) 'Запись строки в файл. При каждом вызове Write, будет записана НОВАЯ строка.
    Close #Ff 'закрываем файл
    'Открываем файл для просмотра
    Set ws = CreateObject("WScript.Shell")
    ws.Run tmpString
    Set ws = Nothing
End Sub
Sub AppendtxtFile() ' Добавляет данные к существующим данным в конец
    Dim tmpString As Variant, Ff As Integer, Cell As Range, strRes As String, ws As Object
    tmpString = GetFilePath
    If tmpString = False Then Exit Sub
    Ff = FreeFile(0)
    
    'Открываем файл в режиме записи (в него), если такого файла не существует, то он будет СОЗДАН!
    Open tmpString For Append As #Ff
    For Each Cell In ActiveCell.CurrentRegion
        strRes = strRes & Cell.Text & " "
    Next Cell
    Write #Ff, Application.WorksheetFunction.Trim(strRes) 'Запись строки в файл. При каждом вызове Write, будет записана НОВАЯ строка.
    Close #Ff 'закрываем файл
    'Открываем файл для просмотра
    Set ws = CreateObject("WScript.Shell")
    ws.Run tmpString
    Set ws = Nothing
End Sub

Sub PrimerFSO()
    'Below assumes you are NOT referencing the Microsoft Scripting Runtime library
    Dim fso As Object, ts As Object
    Const ForReading = 1, ForWriting = 2, ForAppending = 8 'Need to define constants manually
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 'Need to define constants manually
    Set fso = CreateObject("Scripting.FileSystemObject")
     
    'The below will not Hello.txt if it does not exist and will open file for Unicode appending
    Set ts = fso.OpenTextFile("C:\Hello.txt", ForAppending, True, TristateFalse)
    ts.WriteLine "Hello"
    ts.Close
     
    'Open same file for reading
    Set ts = fso.OpenTextFile("C:\Hello.txt", ForReading, True, TristateFalse)
     
    'Read till the end
    Do Until ts.AtEndOfStream
         Debug.Print "Printing line " & ts.Line
         Debug.Print ts.ReadLine 'Print a line from the file
    Loop
    ts.Close
End Sub