Проблемы с чтением и записью в файл в Юникоде

[ymnuhj]

Добрый день. Есть код:
Запись в файл:

Option Explicit
Sub SavingCaseAsUnicodeFile()
Dim FileName, SheetName As String, SupportingSheet As String, Buffer As String
Dim column As Integer, i As Integer
'preferences
FileName = Application.GetSaveAsFilename( _
fileFilter:="Text Files (*.case), *.case")
SheetName = "Лист1"
SupportingSheet = "Лист2"
column = 2
If FileName <> False Then
i = 1
For i = 1 To 400
Buffer = ThisWorkbook.Sheets(SheetName).Cell s(i, column).Value
ThisWorkbook.Sheets(SupportingSheet ).Cells(i, 1).Value = Buffer
Next i

Sheets(SupportingSheet).Copy
ActiveWorkbook.SaveAs FileName, xlUnicodeText
ActiveWorkbook.Close False
Sheets(SheetName).Select
Else
End If
End Sub

Чтение из файла:

Option Explicit
Function GetFilePath(Optional ByVal Title As String = "Choose File for work", _
Optional ByVal InitialPath As String = "c:\", _
Optional ByVal FilterDescription As String = "Case", _
Optional ByVal FilterExtention As String = "*.*")
Dim ps As String
On Error Resume Next
With Application.FileDialog(msoFileDialo gOpen)
.ButtonName = "Choose": .Title = Title: .InitialFileName = InitialPath
.Filters.Clear: .Filters.Add FilterDescription, FilterExtention
If .Show <> -1 Then Exit Function
GetFilePath = .SelectedItems(1): ps = Application.PathSeparator
End With
End Function
Sub ImportCase()
Dim Simv As String * 2, FileName As String, SheetName As String, s As String
Dim i As Integer

FileName = GetFilePath("Choose case for import", , "Case", "*.case")
SheetName = "Ëèñò1"

If FileName = "" Then Exit Sub ' exit in the case of refuse
Open FileName For Random As #1 Len = 2
i = 1
Do While Not EOF(1)
Get #1, , Simv
s = StrConv(Simv, vbFromUnicode)
If s = Chr(13) Then
i = i + 1
Get #1, , Simv
Sheets(SheetName).Cells(i, 1) = ""
Else
Sheets(SheetName).Cells(i, 1) = Cells(i, 1) + s
End If
Loop
Close #1
End Sub

Причем как оказалось с обеими частями есть проблемы.
1)При сохранении в файл есть нежелательный промежуточный шаг записи нужного столбца на чистый лист, так как даннай код сохраняет только лист целиком.
2)Чтение оказывается выдает самые разные ошибки, иногда проглатывает кавычки, иногда раздваивает последнюю букву, иногда вместо 111111 или 222 возвращает 6(На снимке первый столбец - загружен из файла, второй исходный).Хотя если текст состоит из одних лишь букав без знаков, проблем никаких .
Выложил обе части потому как что то мне подсказывает если чуток изменить код записи, код чтения не будет работать всовсем.

Очень прошу помогите решить данные проблемы.

[EducatedFool]

Что-то как-то сложно всё у вас.

Не понял, для чего всё это нужно.
Зачем, к примеру, именно Unicode?

Вы бы объяснили, для чего всё это (и как должно работать) - а мы, глядишь, что-нибудь и придумали.

PS: Посмотрите эти функции - может, что и пригодится:
http://excelvba.ru/code/GetFileOrFolderPath
http://excelvba.ru/code/CSV2Excel
http://excelvba.ru/code/TextFile2Array
http://excelvba.ru/code/Range2CSV
http://excelvba.ru/code/Text2Array
http://excelvba.ru/code/Array2worksheet
http://excelvba.ru/code/txt

[Hugo121]

По записи в файл одного столбца есть такой пример (скорректировал под задачу, работает):

Sub Экспорт()
Dim FileName
FileName = Application.GetSaveAsFilename( _
    fileFilter:="Text Files (*.case), *.case")
Open FileName For Output As #1
Print #1, Join(Application.Transpose([B1:B20].Value), vbLf)
Close #1
End Sub

[Hugo121]

Чуть исправил, добавьте свою функцию GetFilePath():

Sub ExportCase()
    Dim FileName
    FileName = Application.GetSaveAsFilename( _
               fileFilter:="Text Files (*.case), *.case")
    Open FileName For Output As #1
    Print #1, Join(Application.Transpose([B1:B20].Value), vbNewLine)
    Close #1
End Sub


Sub ImportCase()
Dim FileName As String
Dim a, i&

FileName = GetFilePath("Choose case for import", , "Case", "*.case")
If FileName = "" Then Exit Sub    ' exit in the case of refuse

a = Split(CreateObject("Scripting.FileSystemObject").Getfile(FileName).OpenasTextStream(1).readall, vbNewLine)
Range("A1").Resize(UBound(a)) = Application.Transpose(a)
End Sub

Range("A1").Resize(UBound(a)) - тут нет ошибки. В файле в конце при записи добавляется ненужный перевод строки, а тут при импорте он отбрасывается
Хотя думаю лучше писать в файл чуть сложнее, без лишнего, и импортировать тогда всё Resize(UBound(a))+1

[ymnuhj]

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

Что-то как-то сложно всё у вас.

Не понял, для чего всё это нужно.
Зачем, к примеру, именно Unicode?

Вы бы объяснили, для чего всё это (и как должно работать) - а мы, глядишь, что-нибудь и придумали.

Да, прошу прошения.

К примеру запущу програмку на русской машине, столбец сохраню в файл. Затемб на английской машине попробую загрузить этот столбец из текстового файла в програмку(Такая ситуация полюбому будет). В таком случае русские буквы превратятся в кракозябры. Для этого нужен Юникод

[ymnuhj]

Hugo. Ваш код гораздо лаконичней моего, что безусловно преимущество. Только на английской машине появляется та проблема что я упомянул в предудущем письме. Результат на снимке

[Казанский]

В проблему не вникал, но может так сделать: сформировать строку из ячеек, переложить ее в байтовый массив, сохранить массив в файл (в двоичном виде).
Потом считать файл в байтовый массив, переложить в строку, разбить на ячейки?

Вот, попробуйте. Полученный файл открывается Блокнотом, причем Блокнот распознает его как Unicode файл.

Sub Save1stColumn()
Dim s$, b() As Byte
s = Join(Application.Transpose(Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value), vbCrLf)
b = s
Open ActiveWorkbook.FullName & ".case" For Binary As #1
Put 1, , b
Reset
End Sub

Sub ReadTo2ndColumn()
Dim s$, b() As Byte, v
Open ActiveWorkbook.FullName & ".case" For Binary As #1
ReDim b(1 To LOF(1))
Get 1, , b
Reset
s = b
v = Split(s, vbCrLf)
Range("B1").Resize(UBound(v) + 1) = Application.Transpose(v)
End Sub

[ymnuhj]

Кажется последний способ не выдает никаких ошибок, простой и надежный. Спасибо, Казанкский

[ymnuhj]

Столкнулся с проблемой что нужно сохранять не один столбец, а два различных столбца с разных листов.

В отдельные файлы сохранить то не сложно. А вот как сохранить их оба в один документ и потом считать оттуда же обратно(используя теже самые функции записи и считывания чтоб проблем с юникодом не возникало)?

А если не два, а допустим 4 столбца?

Заранее спасибо