Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Создается ненужный перенос строки, при сохранении в txt
 
Здравствуйте.
Сохраняю содержимое трех листов книги, в которых от 1 до 4 столбцов и от 4 до примерно 60 строк, в формат xlText, при этом, после того, как открою созданные txt файлы, вижу, что после последней строки, осуществлен перенос курсора на новую строку. Необходимо, чтобы файлы txt создавались без этого переноса, так как он мешает при дальнейшем импорте этих файлов в сторонний программный продукт. Файл с образцом проблемы прикрепил. Файл создан в Excel 2013.
Благодарю.
 
От этой беды можно избавиться так (см. процедуру Test):
Код
Option Explicit
Sub TruncFile(ByVal FileName)
    Const ForReading = 1, ForWriting = 2
    Dim MyFile, s
    Set MyFile = fso.OpenTextFile(FileName, ForReading)
    If Not MyFile.AtEndOfStream Then
        s = MyFile.ReadAll
        While Right(s, 1) = vbLf Or Right(s, 1) = vbCr
            s = Left(s, Len(s) - 1)
        Wend
        MyFile.Close
        Set MyFile = fso.OpenTextFile(FileName, ForWriting, True)
        MyFile.Write s
    End If
    MyFile.Close
    Set MyFile = Nothing
 End Sub

Function fso() As Object
    Static o_fso As Object
    If o_fso Is Nothing Then
        Set o_fso = CreateObject("Scripting.FileSystemObject")
    End If
    Set fso = o_fso
End Function

Sub test()
    TruncFile "C:\Temp\Иванов И.И. Дисциплины.txt"
End Sub
Изменено: sokol92 - 29 Июл 2019 13:58:07
Владимир
 
sokol92, Спасибо огромное! Все работает.  
 
Успехов!
Владимир
 
sokol92,  А что не сразу без  SaveAs в txt без последнего VbCrLf?
 
Михаил, можно, конечно, но я всегда предпочитаю встроенные средства самописным (даже не проверяя эффективности). Что-то это мне напоминает по части формул. :)  

Кроме того, приведенная функция может быть полезной и в других контекстах.
Владимир
 
Цитата
sokol92 написал:
Кроме того, приведенная функция может быть полезной и в других контекстах.
Добрый вечер, Владимир.
Может её регулярками осовременить?
Код
Public Sub testRemoveLastCrLfs(ByVal FileName As String)
    Const ForReading = 1, ForWriting = 2
    Dim pReg As Object, fileText As String
    Dim fso As Object, pStream As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set pStream = fso.OpenTextFile(FileName, ForReading)
    fileText = pStream.ReadAll
    pStream.Close
    Set pReg = CreateObject("VBScript.RegExp")
    pReg.Pattern = "[\n\r]*$"
    fileText = pReg.Replace(fileText, "")
    Set pStream = fso.OpenTextFile(FileName, ForWriting, True)
    pStream.Write fileText
    pStream.Close
End Sub
 
Здравствуйте, Андрей! Конечно, я не против "осовременивания". :)
Хотя, у регулярных выражений довольно почтенный возраст.
Владимир
Страницы: 1
Читают тему (гостей: 1)
Наверх