Страницы: 1
RSS
Макрос сохранения в csv UTF-8
 
Здравствуйте,
Моей задачей было создать макрос, чтобы при сохранении файла Excel, создавался также этот файл в формате .csv. Но у меня никак не получается сделать так, чтобы данные в csv были в UTF-8. (При открытии csv файла, на месте текстовых полей у меня отображаются знаки вопроса). Экслевский файл во вложении.
Код
Sub csvDelim()

Dim i As Long, j As Long
Dim PathForFile As String
Dim NameForSave As String
Dim tempstr As String
Dim Rn As Range
Dim Delim1 As String
Dim Delim2 As String
Dim Val
On Error Resume Next
PathForFile$ = ThisWorkbook.Path & "\csv файл\": MkDir PathForFile$
MsgBox "На вашем локальном диске будет создана папка ""csv файл""", vbOKOnly, "Создание папки"

If Err.Number <> 75 And Err.Number <> 0 Then GoTo Ext
Err.Clear
On Error GoTo Ext
NameForSave = InputBox("Введите маску имени файла", "Ввод", ActiveWorkbook.Name)
Delim1 = CStr(";")
Delim2 = CStr("")
Randomize
NameForSave = NameForSave & "_" & CStr(Date)
Set Rn = Range("A1:Q1")
i = 1
While Len(Rn.Cells(1).Offset(i).Value) > 0
    i = i + 1
Wend
If i = 1 Then Exit Sub
Val = Rn.Offset(1).Resize(i).Value
On Error Resume Next
Kill PathForFile$ & "\" & NameForSave & ".csv"
Err.Clear
On Error GoTo Ext
Open PathForFile$ & "\" & NameForSave & ".csv" For Output As #1
For i = 1 To UBound(Val, 1) - 1
    tempstr = Delim2 & CStr(Val(i, 1)) & Delim2
    For j = 2 To UBound(Val, 2)
        tempstr = tempstr & Delim1 & Delim2 & CStr(Val(i, j)) & Delim2
    Next j
    Print #1, tempstr
Next i
Close #1
Exit Sub
Ext:
MsgBox "извините, ошибка!" & Err.Number & " " & Err.Description, vbOKOnly, "Отмена"
End Sub
 
Доброе время суток.
А чем вас подобное решение не устроило? Если не подошло оно, то в инете их вагон и маленькая тележка :)
 
Пошукал по форуму, нашёл своё же древнее (вернее не моё, но пост мой), проверяйте.
Изменено: Hugo - 17.01.2020 13:54:19
Страницы: 1
Наверх