Question

我已经编写了我的第一个VBA宏，用于从XLS导出数据行以在特定位置分离命名的XML文件。我最初进行的简化测试运行良好，但是完整版本错误并显示以下消息：

运行时错误91：对象变量或未设置块变量

宏：

  Sub XML()
 sTemplateXML = _
"<?xml version='1.0'?>" + vbNewLine + _
 "<FromEmail>" + "</FromEmail>" + vbNewLine + _
 "<FromName>" + "</FromName>" + vbNewLine + _
 "<ToEmail>" + "</ToEmail>" + vbNewLine + _
 "<CCAddresses>" + "</CCAddresses>" + vbNewLine + _
 "<BCCAddresses>" + "</BCCAddresses>" + vbNewLine + _
 "<ReplyTo>" + "</ReplyTo>" + vbNewLine + _
 "<Subject>" + "</Subject>" + vbNewLine + _
 "<Body>" + "</Body>" + vbNewLine + _
 "</EmailValues>" + vbNewLine

 Set doc = CreateObject("MSXML2.DOMDocument")
 doc.async = False
 doc.validateOnParse = False
 doc.resolveExternals = False

With ActiveWorkbook.ActiveSheet
lLastRow = ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count

For lRow = 2 To lLastRow
sFile = ActiveWorkbook.ActiveSheet.Cells(lRow, 13).Value
sfromemail = ActiveWorkbook.ActiveSheet.Cells(lRow, 3).Value
sFromname = ActiveWorkbook.ActiveSheet.Cells(lRow, 2).Value
sToEmail = ActiveWorkbook.ActiveSheet.Cells(lRow, 5).Value
sCCAddresses = ActiveWorkbook.ActiveSheet.Cells(lRow, 7).Value
sBCCAddresses = ActiveWorkbook.ActiveSheet.Cells(lRow, 8).Value
sReplyTo = ActiveWorkbook.ActiveSheet.Cells(lRow, 4).Value
sSubject = ActiveWorkbook.ActiveSheet.Cells(lRow, 11).Value
sBody = ActiveWorkbook.ActiveSheet.Cells(lRow, 12).Value


doc.LoadXML sTemplateXML
doc.getElementsbyTagName("FromEmail")(0).appendChild 
doc.createTextNode(sfromemail) (ERROR POPS UP HERE)
doc.getElementsbyTagName("FromName")(0).appendChild 
doc.createTextNode(sFromname)
doc.getElementsbyTagName("ToEmail")(0).appendChild 
doc.createTextNode(sToEmail)
doc.getElementsbyTagName("CCAddresses")(0).appendChild 
doc.createTextNode(sCCAddresses)
doc.getElementsbyTagName("BCCAddresses")(0).appendChild 
doc.createTextNode(sBCCAddresses)
doc.getElementsbyTagName("ReplyTo")(0).appendChild 
doc.createTextNode(sReplyTo)
doc.getElementsbyTagName("Subject")(0).appendChild 
doc.createTextNode(sSubject)
doc.getElementsbyTagName("Body")(0).appendChild doc.createTextNode(sBody)

doc.Save sFile
Next

End With
End Sub

Answer 1

经过一些重构，可能会更整洁：

Sub SaveRowsToXml()
    Dim lLastRow As Long, lrow As Long
    With ActiveWorkbook.ActiveSheet
        lLastRow = .UsedRange.Rows.Count
        For lrow = 2 To lLastRow
            SaveToXml .Rows(lrow)
        Next lrow
    End With
End Sub

'save a single row of data as XML
Sub SaveToXml(rw As Range)
    Dim doc As Object, r
    Set doc = CreateObject("MSXML2.DOMDocument")
    doc.appendChild doc.createProcessingInstruction("xml", "version='1.0'")
    Set r = doc.createElement("EmailValues") '<< create the root element
    doc.appendChild r
    'append child nodes
    r.appendChild NodeWithContent(doc, "FromEmail", rw.Cells(3).Value)
    r.appendChild NodeWithContent(doc, "FromName", rw.Cells(2).Value)
    r.appendChild NodeWithContent(doc, "ToEmail", rw.Cells(5).Value)
    r.appendChild NodeWithContent(doc, "CCAddresses", rw.Cells(7).Value)
    'etc
    'etc
    'Debug.Print doc.XML
    doc.Save rw.Cells(13).Value
    Set doc = Nothing
End Sub

'return a named element with content
Function NodeWithContent(doc, nodename, content)
    Dim el
    Set el = doc.createElement(nodename)
    el.appendChild doc.createTextNode(content)
    Set NodeWithContent = el
End Function

尝试将数据从XLS导出到命名XML文件时出现运行时错误错误

1 个答案: