Excel to XML nested elements - excel

I am trying to use Excel to generate an XML ,Overview of XML in Excel & Export XML data
My XML looks something like this,more blocks and elements,this is just an example, :
<Block>
<Element1>XXX</Element1>
<Element2>YYY</Element2>
<Element3>ZZZ</Element3>
<Nested_Elements>
<Nested_Element>AAA</Nested_Element>
<Nested_Element>BBB</Nested_Element>
<Nested_Element>CCC</Nested_Element>
</Nested_Elements>
</Block>
in Excel I can map element1 ,element2 and element3 add diffrent values and export to XML,all works in a nice easy way ,which is exactly why I used excel instead of writing a python or c# code,the problem is with Nested_Element1 , Nested_Element2 ,Nested_Element3 .
After alot of search I think there is no way to do nested elements directly with Excel ,what would be the best intermidiate tool to use for this ,My knowledge with Excel is not very good ,so is VBA the only way to do it ?
and if I use VBA will I have to create a code to write the whole XML file so cannot make use of the Excel feature Export XML ?

Ok ,it truned out very easy but I will post an answer here in case someone is still searching for this ,
1- Map flat elements between excel cells with XML Map source .
2- VBA code to export the XML :
'Export XMLMap from worksheet,this will export the flat Mapped elements
Set Map = ActiveWorkbook.XmlMaps(1)
Map.Export Url:=XmlFile, Overwrite:=True
're-Load XML as DOM to process it
Set XDoc = New MSXML2.DOMDocument
XDoc.async = False: XDoc.validateOnParse = False
XDoc.Load XmlFile
'Update XML with nested elements
CellText = sheet_Board.Cells(22, "C").Value 'cell having nested elements values separated with "," ===> AAA,BBB,CCC
Set Node = XDoc.SelectSingleNode("//Block")
Set nodChild = XDoc.createElement("Nested_Elements")
Result = Split(CellText, ",")
For i = LBound(Result()) To UBound(Result())
Set nodGrandChild = XDoc.createElement("Nested_Element")
nodGrandChild.Text = Result(i)
nodChild.appendChild nodGrandChild
Next i
Node.appendChild nodChild
This will create an XML with the added nested nodes having no indentation :
<Block>
<Element1>XXX</Element1>
<Element2>YYY</Element2>
<Element3>ZZZ</Element3>
<Nested_Elements><Nested_Element>AAA</Nested_Element><Nested_Element>BBB</Nested_Element><Nested_Element>CCC</Nested_Element></Nested_Elements></Block>
To Fix the indentation add this piece of code (from stackoverflow https://stackoverflow.com/a/37634549/14360302)
Set xslDoc = New MSXML2.DOMDocument
xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _
& "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _
& " xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _
& " <xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _
& " <xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _
& " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _
& " <xsl:template match=" & Chr(34) & "node() | #*" & Chr(34) & ">" _
& " <xsl:copy>" _
& " <xsl:apply-templates select=" & Chr(34) & "node() | #*" & Chr(34) & " />" _
& " </xsl:copy>" _
& " </xsl:template>" _
& "</xsl:stylesheet>"
xslDoc.async = False
Set XmlNewDoc = New MSXML2.DOMDocument
XDoc.transformNodeToObject xslDoc, XmlNewDoc 'Line to fix indention
XmlNewDoc.Save XmlFile

Related

Inserting formula as string into a cell

It seems to be a problem with some characters in it
My original formula in the worksheet (working):
ThisWorkbook.Worksheets("Zazmluvnenia").Cells("3", "AM").Value = "=Výkony!M4 & ", " & TEXT(Výkony!J4;"d.m.yyyy") & ", " & TEXT(Výkony!K4;"hh:mm")"
Putting this into VBA doesn't work because of the quotes. I tried to solve the problem this way: How do I put double quotes in a string in vba?
I changed my code according to the answers on the question above:
"=Výkony!M3 & " & Chr(34) & ", " & Chr(34) & " & TEXT(Výkony!J3;" & Chr(34) & "d.m.yyyy" & Chr(34) & ") & " & Chr(34) & ", " & Chr(34) & " & TEXT(Výkony!K3;" & Chr(34) & "hh:mm" & Chr(34) & ")"
And error '1004' occurred.
Double Quotes vs CHR(34)
Your CHR solution was almost fine, but you didn't know that VBA doesn't recognize the semi-colon (;) as a separator like Excel does. You always have to replace every semi-colon (used as a separator) with a comma in VBA.
Similarly VBA uses the dot (.) as the decimal separator.
The Code
Option Explicit
Sub SEMI()
Dim strF As String
' Double double-quotes ("") in several rows.
strF = "=Výkony!M4&"", """ _
& "&TEXT(Výkony!J4,""d.m.yyyy"")&"", """ _
& "&TEXT(Výkony!K4,""hh:mm"")"
' CHR(34) in several rows.
strF = "=Výkony!M4&" & Chr(34) & ", " & Chr(34) _
& "&TEXT(Výkony!J4," & Chr(34) & "d.m.yyyy" & Chr(34) & ")&" _
& Chr(34) & ", " & Chr(34) _
& "&TEXT(Výkony!K4," & Chr(34) & "hh:mm" & Chr(34) & ")"
' Double double-quotes ("") in one row.
strF = "=Výkony!M4&"", ""&TEXT(Výkony!J4,""d.m.yyyy"")&"", ""&TEXT(Výkony!K4,""hh:mm"")"
' CHR(34) in one row.
strF = "=Výkony!M4&" & Chr(34) & ", " & Chr(34) & "&TEXT(Výkony!J4," & Chr(34) & "d.m.yyyy" & Chr(34) & ")&" & Chr(34) & ", " & Chr(34) & "&TEXT(Výkony!K4," & Chr(34) & "hh:mm" & Chr(34) & ")"
ThisWorkbook.Worksheets("Zazmluvnenia").Cells("3", "AM").Value = strF
End Sub

Saving a XML File with a specific name in a specific path location in VBA

I have written some code that converts my Excel file into a XML data form, however I cannot figure out a way to save the new document to a specific location with a specific name.
So far I have tried to find some that will give me the option to save the filename, however everything I have found so far will only let me put in a path name when I attempt to save it. Like Document.Save "Path" will only allow me to save to the path location and will not keep the file name that I have stored in a variable.
xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _
& "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _
& " xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _
& "<xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _
& "<xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _
& " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _
& " <xsl:template match=" & Chr(34) & "node() | #*" & Chr(34) & ">" _
& " <xsl:copy>" _
& " <xsl:apply-templates select=" & Chr(34) & "node() | #*" & Chr(34) & " />" _
& " </xsl:copy>" _
& " </xsl:template>" _
& "</xsl:stylesheet>"
xslDoc.async = False
doc.transformNodeToObject xslDoc, newDoc
Dim Docname As String
Docname = "VMM_" & SN.Text
fileSaveName = GetSaveAsFilename(InitialFileName:=sItem * Docname, filefilter:="XML Files (*.xml),*xml")
newDoc.SaveAs Filename:= fileSaveName, FileFormat:=xlTextPrinter, CreateBackup:False
I found code that helped me convert my code to XML which is the first part of it, however I cant find out how to use the SaveAs with the newDoc which is a MSXML2.DOMDocument60. I'm trying to save it with the filename Docname, in the location which is called sItem, any help would be greatly appreciated

Invalid Qualifier when checking for a specific character in visual basic

Hi i am trying to check for a specific character in visual vba but i encountered the "INVALID QUALIFIER" error when i run my code.
This is my code:
For i = LBound(rtv) To UBound(rtv) - 1
If rtv(i).Contains(":") Then
Value = Split(rtv(i), ":")
rtv(i) = Chr(34) & Value(0) & Chr(34) & ":" & Chr(34) & Value(1) & Chr(34) & ";"
Else
rtv(i) = Chr(34) & rtv(i) & Chr(34) & ":" & Chr(34) & Chr(34)
' rtv(i) = Chr(34) & rtv(i) & Chr(34) & ":" & Chr(34) & Chr(34) & ";"
Next i
The error lies in the IF statement condition but i have no idea what i am doing wrong here. Any help ?
As noted in the comments, rtv(i).Contains() won't work. Arrays don't have functions or properties that you can use this way.
Use this instead:
If InStr(rtv(i),":") > 0 Then

Excel VBA #SQL String filter

I have been struggling on making this statement a NOT statement:
strfilter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%undeliverable%'"
this strfilter is being used in a items.restrict(strfilter), so obviously it's checking for all emails that contains the word undeliverable.
What I need to do is convert this statement so that it will EXCLUDE all emails with the subject containing the Words "undeliverable".
I've tried this but it returned a parse error:
"strFilter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " NOT '%undeliverable%'"
thanks in advance.
The Correct syntax is
Filter = "#SQL=" & " Not " & _
"urn:schemas:httpmail:subject" & "" & _
" Like '%undeliverable%'"
Or I prefer this then Like
strFilter = "#SQL=" & " Not " & _
"urn:schemas:httpmail:subject" & "" & _
" ci_phrasematch 'undeliverable'"

Paste excel formula (excel format) in a cell using excel VBA?

How do I insert or paste the large excel formula in a specific cell in excel formula formate only. My project has large excel table to calulate no. days left and it is linked with current date and time. formula has to be inserted in column whenever i submitted the data from data entry form. It automatically collects the values from different cells in a current sheet and calculates.
But here i getting "compile error, expected end of statement" at formula line ie., at double quatotions "".
I could write directly in excel and drage
or
I could write vba code for the above calculation but due to my project requirement, i have to be inserted the formula.
Is there any way to insert the formula???? i'm using excel 2016
Set Fcell = formulaWks.Range("O7")
'formula = "=$A1+$B1" ' example for testing
Formula = "=IF(YEAR(NOW())=$W$3,IF(ISBLANK($G7),"",IFERROR(IF(DATEDIF(TODAY(),$N7,"y")=0,"",DATEDIF(TODAY(),$N7,"y")&" y ")&IF(DATEDIF(TODAY(),$N7,"ym")=0,"",DATEDIF(TODAY(),$N7,"ym")&" m ")&IF(DATEDIF(TODAY(),$N7,"md")=0,"",DATEDIF(TODAY(),$N7,"md")&" d"),"wrong date")),"Package completed")"
Fcell = ActiveCell.formula
Try the code below, it will work with your basic formula that you wanted to test.
Option Explicit
Sub InsertFormula()
Dim formulaWks As Worksheet
Dim Fcell As Range
Dim FormulaString As String
' modify "Sheet1" to your sheet's name
Set formulaWks = Worksheets("Sheet1")
Set Fcell = formulaWks.Range("O7")
FormulaString = "=$A1+$B1" ' example for testing
Fcell.Formula = FormulaString
End Sub
Regarding your "LONG" formula, the formula string below passes:
FormulaString = "=IF(YEAR(NOW())=$W$3,IF(ISBLANK($G7)," & Chr(34) & Chr(34) & ",IFERROR(IF(DATEDIF(TODAY(),$N7," & Chr(34) & "y" & Chr(34) & ")=0," & Chr(34) & Chr(34) & ",DATEDIF(TODAY(),$N7," & Chr(34) & "y" & Chr(34) & ")&" & Chr(34) & " y " & Chr(34) & ")" & _
"&IF(DATEDIF(TODAY(),$N7," & Chr(34) & "ym" & Chr(34) & ")=0," & Chr(34) & Chr(34) & ",DATEDIF(TODAY(),$N7," & Chr(34) & "ym" & Chr(34) & ")&" & Chr(34) & " m " & Chr(34) & ")" & _
"&IF(DATEDIF(TODAY(),$N7," & Chr(34) & "md" & Chr(34) & ")=0," & Chr(34) & Chr(34) & ",DATEDIF(TODAY(),$N7," & Chr(34) & "md" & Chr(34) & ")&" & Chr(34) & " d" & Chr(34) & ")," & _
Chr(34) & "wrong date" & Chr(34) & "))," & Chr(34) & "Package completed" & Chr(34) & ")"
Debug.Print FormulaString ' for debug, to see the Formula string in the immediate window
Note: Final version of the "long" formula has been edited in by YowE3K - if it doesn't work, blame me (i.e. YowE3K) not Shai.
You need to escape double quotes from the string first by adding double quotes twice in the string like this - ISBLANK($G7),""""
Then use formula like this
Range("O7").Formula = "[Your formula with escaped double quotes]"

Resources