VBA, MS Access MS Access в примерах

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

По материалам: https://www.cyberforum.ru/vba/thread3131491.html#post17060054

Надёжнее работает старый добрый способ:

    Open sFilePath For Output As #1
    Print #1, sVal ' Пишем тело (онострочное)
    Close #1


Ещё можно записать тело страницы в файл используя ADODB.Stream:

[Public Function CreateTextFileUTF8(sText, sFilePath$) As Long
' s0000890 v003 - Создание текстового файла в кодировке: utf-8 - возвращает 0 или код ошибки
' -------------------------------------------------------------------------------------------------/
Dim objBinaryStream As Object
On Error GoTo CreateTextFileUTF8_Err
    Set objBinaryStream = CreateObject("ADODB.Stream")
    With objBinaryStream
        .Type = 2
        .Charset = "utf-8"
        .Open
        .WriteText sText
        .SaveToFile sFilePath, 2
        .Close
    End With

CreateTextFileUTF8_End:
    On Error Resume Next
    Set objBinaryStream = Nothing
    Err.Clear
    Exit Function

CreateTextFileUTF8_Err:
    CreateTextFileUTF8 = Err.Number
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Function :" & _
        "CreateTextFileUTF8.", vbCritical, "Error!"
    Err.Clear
    Resume CreateTextFileUTF8_End
End Function


Используя FSO:

Dim sVal$, sFilePath$
Dim sText$, sChr$, iVal%
Dim objFSOFile As Object
    
    sFilePath = "D:\Temp\Код_страницы_макросом_FSO.txt"
    sVal = "Your text ...(file body)"

'Очистка от не распознаваемых символов в теле страницы (опционально - а ведь могут быть):
    For iVal = 1 To Len(sVal)
        sChr = Mid(sVal, iVal, 1)
        If AscW(sChr) > 0 Then
           sText = sText & sChr
        End If
    Next iVal

    Set objFSOFile = CreateObject("Scripting.FileSystemObject").CreateTextFile(sFilePath, True)
    objFSOFile.Write sText ' Пишем полученный текст из переменной в файл 
    objFSOFile.Close

Set objFSOFile = Nothing
Назад ToTop
L.E. 15.04.2024
Рейтинг@Mail.ru