Run time error error when trying to export data from XLS to a named XML file

I've written my first VBA macro to export rows of data from XLS to separate named XML files in a specific location. My initial, simplified tests went fine but the full version errors with the message:

Run-time error 91: object variable or with block variable not set

macro:

  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

1 answer

  • answered 2018-12-05 21:17 Tim Williams

    Could be much tidier with a little refactoring:

    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