write to Xml

[Dossfm0q]

what wrong I have

Public Sub Creat()


Dim docPropsXML As String
Dim docPropsFolder As String
'Creating the Document Properties
FilePath = ThisWorkbook.Path & "\"
RootFolder = FilePath & "root"
docPropsFolder = RootFolder & "\" & "docProps"
If Len(Dir(RootFolder, vbDirectory)) = 0 Then MkDir RootFolder
If Len(Dir(docPropsFolder, vbDirectory)) = 0 Then MkDir docPropsFolder
docPropsXML = "<!--?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?--> " & vbNewLine & _
"<properties xmlns=" & vbNewLine & _
"  ="" ""http:="" schemas.openxmlformats.org="" officedocument="" 2006="" extended-properties""="" "="" &="" vbnewline="" _
"   xmlns:vt=""http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes""> " & vbNewLine & _
"    <template>Normal.dotm</template> " & vbNewLine & _
"    <totaltime>1</totaltime> " & vbNewLine & _
"    
1 " & vbNewLine & _
"    <words>3</words> " & vbNewLine & _
"    <characters>23</characters> " & vbNewLine & _
"    <application>Microsoft Office Word</application> " & vbNewLine & _
"    <docsecurity>0</docsecurity> " & vbNewLine & _
"    <lines>1</lines> " & vbNewLine & _
"    
1 " & vbNewLine & _
"    <scalecrop>false</scalecrop> " & vbNewLine & _
"    <company>MS</company> " & vbNewLine & _
"    <linksuptodate>false</linksuptodate> " & vbNewLine & _
"    <characterswithspaces>25</characterswithspaces> " & vbNewLine & _
"    <shareddoc>false</shareddoc> " & vbNewLine & _
"    <hyperlinkschanged>false</hyperlinkschanged> " & vbNewLine & _
"    <appversion>12.0000</appversion> " & vbNewLine & _
" </properties>"




Call ToText(docPropsXML, docPropsFolder, "app", "xml")




End Sub
Public Sub ToText(TXT As String, Path As String, FileName As String, Ext As String)


 Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim Fileout As Object


    Dim objShell As Object
    Dim strWordExe As String
    Set objShell = CreateObject("WScript.Shell")
    strWordExe = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\Winword.exe\")


On Error Resume Next
'Path = CreateObject("WScript.Shell").SpecialFolders("Desktop")
'Ext = "doc" ' or Ext="CV"
Set Fileout = fso.CreateTextFile(Path & "\" & FileName & "." & Ext, True, True)
  On Error GoTo 0
  On Error Resume Next


         Fileout.Write TXT
    Fileout.Close
    
    If InStr(1, Ext, "txt", vbTextCompare) > 0 Then Shell "Notepad" & " " & Path & "\" & FileName & "." & Ext, vbMaximizedFocus
    If InStr(1, Ext, "DOc", vbTextCompare) > 0 Then Shell strWordExe & " " & Path & "\" & FileName & "." & Ext, vbMaximizedFocus
    If InStr(1, Ext, "htm", vbTextCompare) > 0 Then Shell "explorer.exe " & Path & "\" & FileName & "." & Ext, vbNormalFocus
End Sub

https://msdn.microsoft.com/en-us/library/bb266220(v=office.12).aspx#office2007wordfileformat_creatingthedocument