Сохранение файла в Dos кодировке

[mistx]

Есть макрос, который на основе данных в ескеле и в msaccess создает текстовый файл, но в кодировке win.
Как можно сохранить его в DOS кодировке?

[Teslenko_EA]

Здравствуйте mistx.
С задачей конвертации поможет справиться функция:

Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" _
(ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Function toDOS(sWin$) As String
    toDOS = Space$(Len(sWin))
    CharToOem sWin, toDOS
End Function

Евгений.

[mistx]

Сообщение от Teslenko_EA

Здравствуйте mistx.
С задачей конвертации поможет справиться функция:

Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" _
(ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Function toDOS(sWin$) As String
    toDOS = Space$(Len(sWin))
    CharToOem sWin, toDOS
End Function

Евгений.

Добрый день, Евгений.
Подскажите, пожалуйста, как мне применить данную функцию конкретно к моей задачи?
После объявления функции, что я должен сделать?

сначала у меня открывается текстовый файл, затем импортируются нужные данные из екселя, затем закрытие.
Application.DisplayAlerts = False
Dim s As TextStream, row As Range
Set s = CreateObject("scripting.filesystemo bject").OpenTextFile(Filename, ForWriting, True)
Application.ScreenUpdating = False
Dim ra As Range: Set ra = ActiveSheet.UsedRange.EntireRow
ra.Columns(2).TextToColumns _
...
...
s.Close

[Teslenko_EA]

Здравствуйте mistx.
Применять функцию можно разместив её код в модуле проекта.
и скорее всего в коде, там где "написаны" многоточия должна быть подобная конструкция:
sTextFile = sText
измените её так:
sTextFile = toDOS(sText)
и будет Вам счастье.
Евгений.

[mistx]

Сообщение от Teslenko_EA

Здравствуйте mistx.
Применять функцию можно разместив её код в модуле проекта.
и скорее всего в коде, там где "написаны" многоточия должна быть подобная конструкция:
sTextFile = sText
измените её так:
sTextFile = toDOS(sText)
и будет Вам счастье.
Евгений.

подобной конструкции в коде нет.
поскольку код большой (внутри все что должно импортироваться и порядок импорта)
привожу основную часть.
похоже здесь только CreateObject("scripting.filesystemo bject").OpenTextFile(Filename, ForWriting, True) создает а ts.close закрывает.

Sub prog()
Application.DisplayAlerts = False
Dim ts As TextStream, row As Range
Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "result.txt")
Set ts =CreateObject("scripting.filesystem object").OpenTextFile(Filename, ForWriting, True)

Application.ScreenUpdating = False
Dim ra As Range: Set ra = ActiveSheet.UsedRange.EntireRow
ra.Columns(2).TextToColumns _
ra.Columns(10).Resize(, 3), xlDelimited, , , , , , True

For Each cell In ra.Columns(4).Cells: Debug.Print cell: ss = ss + Val(cell): Next
сумма = Replace(FormatNumber(ss, 2), ",", ".")

ra.Resize(, 12).EntireColumn.AutoFit
Application.DisplayAlerts = True
End Sub
ts.close

[Teslenko_EA]

Здравствуйте mistx.
Подозреваю переменной ss заполняется тело файла, судить о способе решения с уверенностью можно только проанализировав всю конструкцию, а не её часть. Возможно приемлемой будет её конвертация после заполнения в цикле.

...
For Each cell In ra.Columns(4).Cells
      ss = ss + Val(cell)
Next
ss = toDOS(ss)
сумма = Replace(FormatNumber(ss, 2), ",", ".")
...

Евгений.
P.S. по правилам форума и для удобочитаемости выкладываемый код заключайте в тэги [соde]...[/соde]