Текстовые Файлы - Запись, Дозапись и Чтение (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