Please check the below code in child node I want to prefix it with "drm:" but I am getting error reference to undeclared namespace prefix: 'drm'
Please check the ConvertTexttoXm l procedure
Please check the ConvertTexttoXm l procedure
Code:
'ForXML
Dim objDom
Dim objRoot
Dim objField
Dim objFieldValue
Dim objcolName
Dim objattTabOrder
Dim objPI
Dim objRow
Sub GenerateXML()
Dim intA As Integer
Dim intB As Integer
Dim Sheet1 As String
Dim ws As Worksheet
' Dim shtArray() As String
Dim shtArrayXML() As String
Dim Answer As String
Dim LRow As Integer: LRow = 3
Dim Row_Max As Integer
Dim LColumnField() As String
Dim LColumnFieldValue() As String
'Declaration
Application.ScreenUpdating = False
Msg10 = "Are you sure you want to Generate XML?"
' Asking whether to Generate XML or not
Answer = MsgBox(Prompt:=Msg10 _
& vbCr & vbCr & "Click Yes to Generate." _
& vbCr & vbCr & "Click No to quit.", _
Title:="Confirmation Message", _
Buttons:=vbYesNoCancel + vbDefaultButton3)
'Answer = Confirmation
If Answer <> vbYes Then
Exit Sub
Else
'Call the function to prepare the Output XML file
PrepareXML (1)
Workbook_Name = "Metadata Utility.xlsm"
totalfields = 0
'LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
'Column till which nodes have to be created
LastColumn = 27
For LColumn = 2 To LastColumn
ReDim Preserve LColumnField(totalfields + 1)
If Cells(5, LColumn).Value <> "" Then
LColumnField(totalfields) = Cells(5, LColumn).Value
totalfields = totalfields + 1
End If
Next LColumn
totalfields = 0
For LColumn = 2 To LastColumn
ReDim Preserve LColumnFieldValue(totalfields + 1)
LColumnFieldValue(totalfields) = Cells(7, LColumn).Value
totalfields = totalfields + 1
Next LColumn
'Sub to prepare nodes of XML
ConvertTexttoXML LColumnField, LColumnFieldValue, totalfields, "Test"
'Prepare final part of the XML
PrepareXML (2)
End If
End Sub
'Function to prepare XML first and end parts
Function PrepareXML(xmlPart)
Select Case xmlPart
Case 1
'Instantiate the Microsoft XMLDOM.
Set objDom = CreateObject("Microsoft.XMLDOM")
' Set objDom = CreateObject("MSXML2.DOMDocument.6.0")
objDom.preserveWhiteSpace = True
'Create your root element and append it to the XML document.
Set objRoot = objDom.createElement("DRMUtility")
objDom.appendChild objRoot
Dim objattTabOrder
Set objattTabOrder = objDom.createAttribute("xml:space")
objattTabOrder.Text = "preserve"
objRoot.setAttributeNode objattTabOrder
Case 2
'Prepare the XML
Set objPI = objDom.createProcessingInstruction("xml", "version='1.0'")
objDom.InsertBefore objPI, objDom.ChildNodes(0)
'Send the XML back after adding encoding -ISO-8859-1 to XML tag to read all languages
xmlOutPut = Replace(objDom.XML, "?>", " encoding=""ISO-8859-1""?>", 1, 1)
Set SendDoc = CreateObject("Microsoft.XMLDOM")
SendDoc.async = False
SendDoc.LoadXML (xmlOutPut)
Dim FolderName As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = Faslse
.Title = "Choose a folder path to save the file"
.Show
On Error Resume Next
FolderName = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End With
If FolderName <> "" Then
XMLFileName = "DRMUtility"
currentTime = Format(Now, "DDMMYYYYhhmmss")
currentXMLFile = XMLFileName & "_" & currentTime & ".xml"
SendDoc.Save (FolderName & "\" & currentXMLFile)
End If
Set SendDoc = Nothing
Set objDom = Nothing
End Select
End Function
'Sub to prepare nodes of XML
Sub ConvertTexttoXML(OutputFields, OutputVal, totalfields, xmlSheetNodeName)
Dim totalnofields
Dim i: i = 0
fieldpart = "drm:"
totalnofields = CInt(totalfields)
fieldpart = "drm:"
Set objRow = objDom.createElement(xmlSheetNodeName)
For i = 0 To totalnofields - 1
Set objField = objDom.createElement(fieldpart & OutputFields(i))
objField.Text = OutputVal(i)
objRow.appendChild objField
Next
objRoot.appendChild objRow
End Sub
Comment