TopPicLogo TopPicText

Текстовые Файлы - Запись, Дозапись и Чтение (FileSystemObject)

'--------------------------------------------------------------------------
' Module    : modTextFiles
' Author    : es
' Date      : 11.12.2016
' Purpose   : Текстовые Файлы - Запись, Дозапись и Чтение (FileSystemObject)
'--------------------------------------------------------------------------
Option Compare Database
Option Explicit

Public Sub TextOutputAsTXT(sTXTPath$, sText$)
'Запись в текстовый файл по пути sTXTPath - текста переданного в sText
'Внимание: Если Файл уже существует - переписывается полностью и без вопросов.
Dim fso As Object
Dim ts As Object
'--------------------------------------------------------------------------
On Error GoTo TextOutputAsTXT_Err
    Set fso = CreateObject("Scripting.FileSystemObject")
    
'Третий параметр <Unicode>. Если он True, файл в юникоде, если False , то в ASCII. По умолчанию стоит False. 
    Set ts = fso.CreateTextFile(sTXTPath, True, False)
    ts.Write sText
    ts.Close
TextOutputAsTXT_Bye:
    On Error Resume Next
    Set ts = Nothing: Set fso = Nothing
    Exit Sub

TextOutputAsTXT_Err:
    MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "в процедуре: TextOutputAsTXT", vbCritical, "Error!"
    Resume TextOutputAsTXT_Bye
End Sub

Public Sub TextOutputAddText(sTXTPath$, sText$)
'Добавление в текстовый файл (в конец) из аргумента sText
Dim fso As Object
Dim ts As Object
'--------------------------------------------------------------------------
On Error GoTo TextOutputAddText_Err
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpenTextFile(sTXTPath, 8, True): ts.Write sText: ts.Close
    Set ts = Nothing: Set fso = Nothing
TextOutputAddText_Bye:
    On Error Resume Next
    Set ts = Nothing: Set fso = Nothing
    Exit Sub

TextOutputAddText_Err:
    MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "в процедуре: TextOutputAddText", vbCritical, "Error in module modTextOutput"
    Resume TextOutputAddText_Bye
End Sub

Public Function TextReadFromFile(sTXTPath$) As String
'Чтение текстового файла в переменную
Dim fso As Object
Dim ts As Object
'--------------------------------------------------------------------------
On Error GoTo TextReadFromFile_Err
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpenTextFile(sTXTPath, 1, True): TextReadFromFile = ts.ReadAll: ts.Close
    Set ts = Nothing: Set fso = Nothing

TextReadFromFile_Bye:
    Exit Function

TextReadFromFile_Err:
    MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "в процедуре: TextReadFromFile", vbCritical, "Error in module modTextOutput"
    Resume TextReadFromFile_Bye
End Function


Пример эксплуотации:

Private Sub TestTXTfile()
Dim sPath$
Dim str$

'Назначаенм куда ...
    sPath = "d:\Temp\TempTest01.txt"
    
'Запись
    str = "01 - Записали ..." & vbCrLf 'Строка + перевод строки
    TextOutputAsTXT sPath, str

'Дозапись
    str = "02 - Дописали" & vbCrLf
    TextOutputAddText sPath, str

'Чтение
    str = "03 - Прочитали ..."
    TextOutputAddText sPath, str

'Пишем что получилось в Immediate окно (Ctrl + G)
    str = TextReadFromFile(sPath)
    Debug.Print "---------------------" & vbCrLf & _
    "Файл: " & sPath & vbCrLf & _
    "Содержит строки:" & vbCrLf & "---------------------" & _
    vbCrLf & str & vbCrLf & "---------------------"

End Sub
Назад ToTop
L.E. 10.02.2017
Рейтинг@Mail.ru