Можно ли сформировать unicode файл из excel-я средствами VBA

[Oleg Tishchenko]

Привет,

Держу в excel каталог своей видеотеки, причем все названия фильмов, имена режиссеров и т.д. и т.п. стараюсь держать на языке оригинала. Языков много, поэтому все хранится в unicode-е. Недавно сделал on-line версию каталога и появилась необходимость периодически все это хозяйство синхронизировать. Делать это я собирался следующим образом - в excel написать макрос, который формировал бы xml файл в utf-8 нужного мне формата, потом этот файл подсовывать софту на сайте, который бы парсил этот файл и укладывал бы данные у себя в базу. Это все предыстория, теперь проблема: после чтения хелпа и главы 13 книги Гарнаева написал я нужный макрос и все бы было хорошо, да вот данные в файле сконвертированы из unicod-а то ли в win1251, то ли в iso8859p1, т.е. если у меня в ячейке стоит, например, Alejandro González Iñárritu, то, в файле, я получаю Alejandro Gonzalez Inarritu

Код: Выделить всё

  Open l_Filename For Output Access Write Lock Write As #1
  Print #1, c_XMLHeader
  Print #1, "<ROWSET>"
  Worksheets(1).Activate
  l_index = ActiveSheet.UsedRange.Rows.Count
 
  For i = 2 To l_index Step 1
    If ActiveSheet.Cells(i, 1).Value = "" Then
      Exit For
    Else
      l_position = l_position + 1
      Print #1, "   <ROW num=" + Chr(34) + CStr(l_position) + Chr(34) + ">"
      Print #1, "      <POS_ID>"; CStr(l_position) + "</POS_ID>"
      Print #1, "      <RELEASE_DATE>" + CStr(ActiveSheet.Cells(i, 2).Value) + "</RELEASE_DATE>"
      Print #1, "      <DIRECTOR_NAME>" + Replace(Trim(ActiveSheet.Cells(i, 3).Value), Chr(10), _
                "&br&") + "</DIRECTOR_NAME>"
      Print #1, "      <POS_TITLE>" + ActiveSheet.Cells(i, 1).Value + "</POS_TITLE>"
      Print #1, "</ROW>"
    End If
  Next i
  Print #1, "</ROWSET>"
  Close #1


Так вот вопрос, все ли я делаю правильно? Можно ли средствами VBA получить unicode файл?
У меня русская Win2000 Prof SP4 и Excel 2002

PS Вопрос предварительно пробывовал погуглить, пояндексить но, видимо, не смог сформулировать нужный критерий поиска - попадался один мусор.

[Igor_123]

Подключи в Referens XML и создавай сразу готовый XML-файл
я пользуюсь версией 3.0
Для установки кодировки документа

Код: Выделить всё

Dim xml As New DOMDocument30
Dim prin As IXMLDOMProcessingInstruction
Set prin = xml.createProcessingInstruction("xml", "version = '1.0' encoding = 'windows-1251'")
xml.appendChild prin

Для создания узла:

Код: Выделить всё

Public Sub Save(ByRef xml As DOMDocument30, ByRef root As IXMLDOMElement)
Dim Item As IXMLDOMElement
Set Item = xml.createElement(mvarkey)
Call SetAttr(xml, Item, True)
root.appendChild Item
End Sub


Для создания и установки атрибутов

Код: Выделить всё

Private Sub SetAttr(ByRef xml As DOMDocument30, ByRef Item As IXMLDOMElement)
Dim att As IXMLDOMAttribute
    Set att = xml.createAttribute("X1")
    att.Text = X1
    Item.setAttributeNode att
End Sub

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

[Igor_123]

Да, забыл самое главное после построения документа делаешь

Код: Выделить всё

xml.Save "c:\FileName.xml"

и по указанному пути получаешь файл.
и ещё одна опечатка в коде для создания узла, вызов функции

Код: Выделить всё

Call SetAttr(xml, Item, True)


необходимо делать без последнего аргумента. т.е. так -

Код: Выделить всё

Call SetAttr(xml, Item)


Желаю удачи

[Oleg Tishchenko]

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

[Igor_123]

Прошу прощения, знак вопроса только сейчас увидел.
Вообще MSDN, интернет.
Но если лезть дальше то сразу нужна информация по XSL( не помню точно как), и DTD. С помощью первого можно описать стили отображения, настроить гиперссылки и т.д. и т.п., а второй это описатель структуры которую ты можеш положить в XML-файл, т.е. задаются ограничения на создание узлов в неразрешённых местах, значения атрибутов и тегов и много чего ещё.
Но я использую XML-файл, как хранилище информации. поэтому пока хватает того, что я тебе дал. Я постараюсь найти файл, который делал для себя по XML, там описание DOMDocument30 и ещё некоторых других классов, как найду дам ссылку. Или вышлю на мыло( которого нет )

[Oleg Tishchenko]

Я постараюсь найти файл, который делал для себя по XML, там описание DOMDocument30 и ещё некоторых других классов, как найду дам ссылку

В общем-то, у меня почти все получилось, спасибо огромное за помощь, единственное, не придумал еще как добавить в xml конструкцию !DOCTYPE, но, все равно было, бы здорово посмотреть пример.

Или вышлю на мыло( которого нет )

Уже есть

[sargio]

а все таки как то возможно сохранить файл в UTF, а не в ANSII.

[tyomitch]

В смысле, записать переменную String в файл в виде UTF8? Возможно.

[sargio]

В смысле, записать переменную String в файл в виде UTF8? Возможно.

Да, в UTF8. у меня получилось только в UTF 16.

Как возможно писать строки в UTF8 не подскажешь?

[tyomitch]

Код: Выделить всё

Option Explicit
Private Const CP_UTF8 As Long = 65001
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long

Sub Test()
Dim s As String
s = "Alejandro Gonz" & ChrW(&HE1) & "lez I" & ChrW(&HF1) & ChrW(&HE1) & "rritu"
WriteUTF8 "c:\alejandr.txt", s
End Sub

Sub WriteUTF8(ByVal FileName As String, ByVal Data As String)
Data = Data & String(Len(Data), 0)
Data = Left(Data, WideCharToMultiByte(CP_UTF8, 0, StrPtr(Data), -1, Data, Len(Data), 0, 0))

Dim fn As Integer: fn = FreeFile
Open FileName For Output As fn
Print #fn, Data;
Close fn
End Sub


[sargio]

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

Можно ли как то открыть файл на запись в UTF-8, по аналогии с открытием на UTF 16

[tyomitch]

В смысле, записать переменную String в файл в виде UTF8? Возможно.

Да, в UTF8.

Ты согласен, что я ответил в точности на поставленный вопрос?

Как открыть файл на запись в UTF8 - я не знаю. Придётся лепить всё в одну строку.

[skiperski]

Код: Выделить всё

Dim oXML As MSXML2.DOMDocument
Dim oNodeMain As MSXML2.IXMLDOMNode
Dim oNodeTemp As MSXML2.IXMLDOMNode

Set oXML = New MSXML2.DOMDocument
oXML.async = False

'add the XML processing instruction
Set oNodeTemp = oXML.createProcessingInstruction("xml", "version=""1.0"" encoding=""UTF-8""")
oXML.appendChild oNodeTemp

Set oNodeMain = oXML.appendChild(oXML.createElement("Video"))

Set oNodeTemp = oNodeMain.appendChild(oXML.createElement("Film"))
oNodeTemp.setAttribute "DIRECTOR_NAME", ...

[tyomitch]

А при чём здесь XML?

[skiperski]

Честно говоря, сильно не вчитывался. В первом сообщении просилось построить XML, в последнем - сохранить файл в формате UTF-8. Вот и получилось. Потом всё это хозяйство с помощью XSL превращяем в HTML. Сейчас попробую - напишу чего получилось.

[tyomitch]

То, что sargio поднял топик полугодовой давности по совсем другому вопросу - ты не заметил?
Няп, sargio не нужен ни XML, ни XSL, ни HTML.

[skiperski]

То, что sargio поднял топик полугодовой давности по совсем другому вопросу - ты не заметил?
Няп, sargio не нужен ни XML, ни XSL, ни HTML.

Точно, не заметил
Тогда и возиться не буду. Предыдущее сообщение считать недействительным.

[sargio]

Код: Выделить всё

Option Explicit
Private Const CP_UTF8 As Long = 65001
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long

Sub Test()
Dim s As String
s = "<?xml version=" & ChrW(34) & "1.0" & ChrW(34) & " encoding=" & ChrW(34) & "UTF-8" & ChrW(34) & " ?>"
WriteUTF8 "c:\alejandr.xml", s
End Sub

Sub WriteUTF8(ByVal FileName As String, ByVal Data As String)
Data = Data & String(Len(Data), 0)
Data = Left(Data, WideCharToMultiByte(CP_UTF8, 0, StrPtr(Data), -1, Data, Len(Data), 0, 0))

Dim fn As Integer: fn = FreeFile
Open FileName For Output As fn
Print #fn, Data;
Close fn
End Sub


Не работает =(

[sargio]

То, что sargio поднял топик полугодовой давности по совсем другому вопросу - ты не заметил?
Няп, sargio не нужен ни XML, ни XSL, ни HTML.

Нужен, нужен XML =).

Просто сейчас уже написана процедура формирования XML в UTF-16.

А хотелось бы в UTF-8 XML писать, не переделывая процедуру формирования.

[sargio]

s = "<?xml version=" & ChrW(34) & "1.0" & ChrW(34) & " encoding=" & ChrW(34) & "UTF-8" & ChrW(34) & " ?> <a>" & ChrW(&HF1) & "</a>"

XML валиден только после удаления последнего символа из файла.

[tyomitch]

Не работает =(

Как - не работает? А что делает?


Если тебе действительно нужен XML, то мой код можешь считать недействительным, и пользоваться встроенными средствами MSXML - тогда действительно заморочек будет меньше.
Удивительно, что до сих пор ты XML не упоминал...

[sargio]

Не работает =(

Как - не работает? А что делает?


Если тебе действительно нужен XML, то мой код можешь считать недействительным, и пользоваться встроенными средствами MSXML - тогда действительно заморочек будет меньше.
Удивительно, что до сих пор ты XML не упоминал...

В конце файле лишний символ образуется.

[sargio]

Если его вручную из файла убрать , то XML становиться валидным.
И все ок.

[sargio]

Если его вручную из файла убрать , то XML становиться валидным.
И все ок.

Ему(Exlporerу) пробелы сформированные через функцию не нравяться.
Если их убираешь или добавляешь через редактор, то все ок.[/u]

[sargio]

Просто строит XML, через соотв. объект не получиться, так как, на сколько я знаю, он появился с версии 2002. А у меня 2000.

[tyomitch]

"Соотв. объект" появился, кажется, в IE4 и к Офису не имеет большого отношения. Т.е. если IE не совсем древний, то и MSXML у тебя есть.

[sargio]

"Соотв. объект" появился, кажется, в IE4 и к Офису не имеет большого отношения. Т.е. если IE не совсем древний, то и MSXML у тебя есть.

Ok. Спасибо, не подскажешь как его подключить, этот объект?.


С проблемой преобразования я решил вопрос. Убрал последний символ и в итоге все ок , заработало. В итоге строчки последний процедуры выглдять. Как :

Код: Выделить всё

Data = Data & String(Len(Data), 0)
Data = Left(Data, WideCharToMultiByte(CP_UTF8, 0, StrPtr(Data), -1, Data, Len(Data), 0, 0))
Data = Mid(Data, 1, Len(Data) - 1)


Уф, изрядно мне этот UTF - 8 нервы потрепал

[tyomitch]

"Соотв. объект" появился, кажется, в IE4 и к Офису не имеет большого отношения. Т.е. если IE не совсем древний, то и MSXML у тебя есть.

Ok. Спасибо, не подскажешь как его подключить, этот объект?.

Tools -> References -> Microsoft XML, version 2.0

С проблемой преобразования я решил вопрос. Убрал последний символ и в итоге все ок , заработало.

Имхо зря старался - всё равно придётся на MSXML переходить

[sargio]

Tools -> References -> Microsoft XML, version 2.0

А если это приложение, где этот объект не подключен, будет ли работать приложение, на мой взгляд - нет?
И если нет, то можно ли как то данные установки сделать програмно?

Имхо зря старался - всё равно придётся на MSXML переходить

Почему? То, что правильнее было с помощью MSXML строить это понятно, однако в данном случае вполне можно обойтись и просто записью в файл.

[tyomitch]

Tools -> References -> Microsoft XML, version 2.0

А если это приложение, где этот объект не подключен, будет ли работать приложение, на мой взгляд - нет?
И если нет, то можно ли как то данные установки сделать програмно?

Ничего не понял. Приложение - это твой экселевский файл с макросом? Ну так подключи - и будет подключено, само же оно не отключится!
Или ты сам вставляешь код макроса в существующий экселевский файл?

Имхо зря старался - всё равно придётся на MSXML переходить

Почему? То, что правильнее было с помощью MSXML строить это понятно, однако в данном случае вполне можно обойтись и просто записью в файл.

Дело, безусловно, твоё. Но я бы на твоём месте переделал всё по-хорошему, если эта прога не на выброс и её в дальнейшем придётся расширять и совершенствовать.