Вызов другого объектаStream.Write текстовый макрос внутри моего макроса не работает

Поэтому я создаю макрос для вывода кодированного UTF-8 XML, поскольку исходный текст иногда включает в себя японские или китайские символы. Я пытаюсь разбить каждый раздел XML на разные куски, поэтому мне легче редактировать, но моя линия вызовов не работает. Поскольку я не обучен программированию, и мои знания основаны на поиске макросов макросов VBA и их настройке до тех пор, пока я не получу желаемый результат, я не понимаю, как заставить макрос objStream не ошибаться при вызове другой строки objStream.

Благодаря!

Вот:

Sub Export_iTunes_XML() Dim FilePath As String FilePath = ActiveWorkbook.Path & "\" Dim FileName As String FileName = "metadata.xml" Dim Output As String Output = FilePath & FileName If Dir(Output, vbNormal) <> "" Then Answer = MsgBox("Do you want to overwrite?", vbOKCancel, "File Exists") End If If Answer = vbCancel Then Exit Sub Set objStream = CreateObject("ADODB.Stream") 'Create the stream objStream.Open 'Initialize the stream objStream.Position = 0 'Rest the position objStream.Charset = "UTF-8" 'indicate the character encoding objStream.WriteText "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCr objStream.WriteText " <title>" & Sheets("RawMetadata").Range("A3") & "</title>" & vbCr If Sheets("RawMetadata").Range("P4") <> 0 Then Call LocaleTest2 objStream.WriteText " <production_company>" & Sheets("RawMetadata").Range("H3") & "</production_company>" & vbCr ___________________________________________________________________________ Sub LocaleTest2() Dim FilePath As String FilePath = ActiveWorkbook.Path & "\" Dim FileName As String FileName = "metadata.xml" Dim Output As String Output = FilePath & FileName Set objStream = CreateObject("ADODB.Stream") 'Create the stream objStream.Open 'Initialize the stream objStream.Position = 0 'Rest the position objStream.Charset = "UTF-8" 'indicate the character encoding objStream.WriteText Sheets("RawMetadata").Range("P4") objStream.CopyTo Output End Sub 

CopyTo ожидает другой объект потока, а не путь строки / файла. Если вы хотите, чтобы LocaleTest2 записывал контент в тот же поток, который уже открыт в Export_iTunes_XML , вы должны передать поток в качестве параметра при вызове LocaleTest2 .

Сделав это изменение, я не уверен, что вы получите какую-либо выгоду от взлома в отдельный Sub.

 Sub Export_iTunes_XML() Dim FilePath As String FilePath = ActiveWorkbook.Path & "\" Dim FileName As String FileName = "metadata.xml" Dim Output As String Output = FilePath & FileName If Dir(Output, vbNormal) <> "" Then Answer = MsgBox("Do you want to overwrite?", vbOKCancel, "File Exists") End If If Answer = vbCancel Then Exit Sub Set objStream = CreateObject("ADODB.Stream") 'Create the stream objStream.Open 'Initialize the stream objStream.Position = 0 'Rest the position objStream.Charset = "UTF-8" 'indicate the character encoding objStream.WriteText "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCr objStream.WriteText " <title>" & Sheets("RawMetadata").Range("A3") & "</title>" & vbCr If Sheets("RawMetadata").Range("P4") <> 0 LocaleTest2 objStream '<<< pass the stream object End If objStream.WriteText " <production_company>" & Sheets("RawMetadata").Range("H3") & "</production_company>" & vbCr '.... End Sub Sub LocaleTest2(objStream as Object) 'write to the provided stream objStream.WriteText Sheets("RawMetadata").Range("P4") End Sub 

Код будет таким.

 Sub Export_iTunes_XML() Dim vR(), myText As String Dim FilePath As String Dim FileName As String Dim Output As String Dim Ws As Worksheet Dim n As Long FilePath = ActiveWorkbook.Path & "\" FileName = "metadata.xml" Output = FilePath & FileName Set Ws = Sheets("RawMetadata") If Dir(Output, vbNormal) <> "" Then Answer = MsgBox("Do you want to overwrite?", vbOKCancel, "File Exists") End If If Answer = vbCancel Then Exit Sub n = n + 1 ReDim Preserve vR(1 To n) vR(n) = "<?xml version=""1.0"" encoding=""UTF-8""?>" n = n + 1 ReDim Preserve vR(1 To n) vR(n) = " <title>" & Sheets("RawMetadata").Range("A3") & "</title>" With Ws If Sheets("RawMetadata").Range("P4") <> 0 Then n = n + 1 ReDim Preserve vR(1 To n) vR(n) = .Range("p4") End If n = n + 1 ReDim Preserve vR(1 To n) vR(n) = " <production_company>" & .Range("H3") & "</production_company>" End With myText = Join(vR, vbCrLf) TransToUTF8 Output, myText End Sub Sub TransToUTF8(myfile As String, str As String) Dim objStream As Object Set objStream = CreateObject("ADODB.Stream") With objStream .Charset = "utf-8" .Open .WriteText str .SaveToFile myfile, 2 .Close End With Set objStream = Nothing End Sub 

прибавление

 Sub Export_iTunes_XML() Dim XMLFileName As String Dim output4 As String Dim range4 As Range Dim vDB, vR(), vResult() Dim i As Long, n As Long, j As Integer Dim myText As String XMLFileName = "metadata.xml" FolderName4 = Sheets("RawMetadata").Range("D42") & "_" & Sheets("iTunes").Range("B8") & ".itmsp" FolderPath4 = ActiveWorkbook.Path & "\" & FolderName4 MkDir FolderPath4 output4 = FolderPath4 & "\" & XMLFileName vDB = Sheets("iTunes").Range("A1:g936") For i = 1 To UBound(vDB, 1) If vDB(i, 7) = "ON" Then ReDim vR(1 To 6) For j = 1 To 6 vR(j) = vDB(i, j) Next j n = n + 1 ReDim Preserve vResult(1 To n) vResult(n) = Join(vR, "") End If Next i myText = Join(vResult, vbCrLf) TransToUTF8 output4, myText End Sub 
  • экспорт китайского символа в файл excel
  • Используйте «ADODB.Stream» для преобразования ANSI в UTF-8, пропустите 1-2 символа в первой строке
  • Читайте в .xlsx с модулем csv в python
  • Excel Экспорт арабского текста английского текста в CSV-файл содержит вопросительные знаки
  • Импортировать текстовый файл как UTF-8
  • Есть ли какой-либо путь через java-программу, я могу сказать Excel открыть файл csv в utf8?
  • Создайте CSV с UTF-8, чтобы открыть с помощью excell
  • Строки из Excel в utf-8 mysql
  • xls в csv, используя POI, где excel имеет другой язык, например, японский, т.е. Символы UTF-8
  • VBA (Excel 2013) сохраняет файл csv с кодировкой UTF-8
  • Как преобразовать имена файлов в iso8859_6 в utf-8?
  • Interesting Posts

    Почему формула = STDEV не равна стандартным отклонениям, которые я вхожу в формулу normdist

    Как автоматически применить путь к файлу из ячейки в VBA?

    Определить индекс столбца в Excel

    Как импортировать этот файл Excel в Python?

    Формулы массива в условном форматировании файлов Excel XML-таблиц?

    Удаление повторяющихся данных из нескольких таблиц Excel

    Шаблон проектирования для обработки водопада

    Получить подробную информацию о URL-адресе в Excel Cell

    Сравните две таблицы данных из разных источников ввода

    VBA – выбор нескольких элементов из раскрывающегося списка

    Нужно сделать обычное сохранение, как для файла с функцией даты и имени

    Получение System.Byte при экспорте изображения из datagridview в excel в c #

    Как я могу удалить строки из excel 2010 Programatically

    Выберите все видимые строки и столбцы Excel

    Исключение при записи в документ xlsx несколько раз с помощью apache poi 3.7

    Давайте будем гением компьютера.