Vba 调用另一个objectStream.Write text宏在我的宏中不是'；t形加工_Vba_Excel_Utf 8_Adodb

Vba 调用另一个objectStream.Write text宏在我的宏中不是'；t形加工

vba excel utf-8

Vba 调用另一个objectStream.Write text宏在我的宏中不是'；t形加工,vba,excel,utf-8,adodb,Vba,Excel,Utf 8,Adodb,因此，我创建了一个宏来输出UTF-8编码的XML，因为源文本有时会涉及日语或中文字符。我试图将XML的每个部分分成不同的块，这样编辑起来就更容易了，但我的电话线不起作用。由于我没有受过编程方面的培训，而且我的知识是基于查找VBA宏代码并调整它们，直到得到所需的结果，因此我很难理解如何使我的objStream宏在调用另一个objStream行时不会出错谢谢这是： Sub Export_iTunes_XML() Dim FilePath As String FilePath = ActiveW

因此，我创建了一个宏来输出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

子导出\u iTunes\u XML（）
将文件路径设置为字符串
FilePath=ActiveWorkbook.Path&“\”
将文件名设置为字符串
FileName=“metadata.xml”
将输出设置为字符串
输出=文件路径和文件名
如果Dir（输出，vbNormal）“，则
Answer=MsgBox（“是否要覆盖？”，vbOKCancel，“文件存在”）
如果结束
如果答案=vbCancel，则退出Sub
设置objStream=CreateObject（“ADODB.Stream”）'创建流
objStream.Open“初始化流”
objStream.Position=0'静止位置
objStream.Charset=“UTF-8”表示字符编码
objStream.WriteText“”&vbCr
objStream.WriteText”“&Sheets（“RawMetadata”）.Range（“A3”）&vbCr
如果Sheets（“rawmatadata”）.Range（“P4”）为0，则调用LocaleTest2
objStream.WriteText”“&Sheets（“RawMetadata”）.Range（“H3”）&vbCr
___________________________________________________________________________
子LocaleTest2（）
将文件路径设置为字符串
FilePath=ActiveWorkbook.Path&“\”
将文件名设置为字符串
FileName=“metadata.xml”
将输出设置为字符串
输出=文件路径和文件名
设置objStream=CreateObject（“ADODB.Stream”）'创建流
objStream.Open“初始化流”
objStream.Position=0'静止位置
objStream.Charset=“UTF-8”表示字符编码
objStream.WriteText表单（“RawMetadata”）.Range（“P4”）
objStream.CopyTo输出
端接头

CopyTo

需要另一个流对象，而不是字符串/文件路径。如果希望

LocaleTest2

将内容写入已在

Export\u iTunes\u XML

中打开的同一流，则在调用

LocaleTest2

时应将该流作为参数传递

虽然做出了这样的改变，但我不确定你是否能从将其拆分成一个单独的子系统中获益

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

子导出\u iTunes\u XML（）
将文件路径设置为字符串
FilePath=ActiveWorkbook.Path&“\”
将文件名设置为字符串
FileName=“metadata.xml”
将输出设置为字符串
输出=文件路径和文件名
如果Dir（输出，vbNormal）“，则
Answer=MsgBox（“是否要覆盖？”，vbOKCancel，“文件存在”）
如果结束
如果答案=vbCancel，则退出Sub
设置objStream=CreateObject（“ADODB.Stream”）'创建流
objStream.Open“初始化流”
objStream.Position=0'静止位置
objStream.Charset=“UTF-8”表示字符编码
objStream.WriteText“”&vbCr
objStream.WriteText”“&Sheets（“RawMetadata”）.Range（“A3”）&vbCr
如果图纸（“原始元数据”）。范围（“P4”）0
localetest2objstream'代码应该是这样的
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

错误是什么？在哪一行？我收到的错误是“objStream.CopyTo Output”行的类型不匹配错误。谢谢@YowE3K-我的缺点是没有更仔细地阅读：当我主要查看CopyTo行时，我错过了重复的相同声明/作业。。。修正了我的答案，谢谢你提出来。谢谢你的帮助，蒂姆！我把这个部分分解成它自己的子部分，因为我因为这个过程太长而出错。我知道我可以循环我试图逐行导出的信息，但由于我的知识有限，我的时间很困难。我也喜欢把它全部写出来，这样我就可以理解每一行是如何工作的。再说一次，我没有编程方面的背景，所以所有这些都需要我花一段时间才能理解。好的-通常是当您遇到“过程太长”时错误那么这是一个危险信号：至少有那么多的代码会使维护和/或调试变得困难。与在一个模块上有不同的子模块相比，最好将这些部分分解为它们自己的模块吗？你只是在那个点上移动问题-如果你有那么多的代码，它通常表明一个基本的问题您的基本方法。例如，您是否将元数据硬编码到VBA中，以便更好地存储在工作表中（例如，范围列表和相应的标记名）？从你发布的代码中很难知道你为什么会达到这个极限。如果你发现你已经把一行代码分成了自己的子代码（它们只会被调用一次），那就不是办法了。谢谢，我也这么认为。我有一个打印脚本，它非常适合我试图输出的XML，但是因为我现在使用的是包含日语和中文字符的源文本，所以我尝试用ADODB流调整我的宏，以便将XML文件输出到UTF-8。我感谢所有的帮助和信息。谢谢李迪的帮助。我现在正在测试它，看看它是如何工作的。我想分享我原来的#print宏，这样这个线程就可以看到我试图从中转换的内容。如果行是“ON”（如果从我提供的代码中可以明显看出这一点，则表示歉意）。正如我之前所说的，它完全按照我想要的方式工作，将XML文件导出到所需的输出文件夹，但一旦我开始接收日语和中文的源文本，输出的XML就开始显示？？？？对于所有外语字符。@ChuckCT36:“utf-8”更改“unicode”和测试代码。非常感谢您的代码。它工作得很好！不仅如此，我还能够遵循您的代码，一点一点地了解它是如何工作的。再次感谢！
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