I'm definitely NOT an expert on XML,
and I dont know if it is a lot different from your approach.
it uses an interim workbook.. then uses ADO to read it directly thru the
Jet engine. The resulting recordset is then saved in XML format.
one thing.. it's simple
Sub SaveAsXml()
Dim cn As Object, rs As Object
Dim rg As Range
Dim cl As Range
Const cNAME = "Adummy"
Dim sPath$, sBook$, sList$
Set rg = Selection.CurrentRegion
If rg.Rows.Count < 2 Or rg.Columns.Count < 2 Then
MsgBox "Make sure you select proper range"
Exit Sub
End If
If ThisWorkbook.Path = "" Then
sPath = VBA.CurDir
Else
sPath = ThisWorkbook.Path & "\"
End If
If Dir(sPath & cNAME & ".xls") <> "" Then Kill sPath & cNAME & ".xls"
If Dir(sPath & cNAME & ".xml") <> "" Then Kill sPath & cNAME & ".xml"
With Workbooks.Add(xlWBATWorksheet)
.Worksheets(1).Name = "Table"
.Worksheets(1).Cells(1).Resize(rg.Rows.Count, rg.Columns.Count).Value =
rg.Value
.SaveAs sPath & cNAME & ".xls"
.Close 0
End With
Set cn = CreateObject("ADODB.Connection")
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.CursorLocation = 3 'adUseClient
cn.Properties("Extended Properties") = "Excel 8.0;IMEX=1;HDR=YES"
cn.Properties("Data Source") = sPath & cNAME & ".xls"
cn.Open
Set rs = cn.Execute("[Table$]", , 2) ' adCmdTable
rs.Save sPath & cNAME & ".xml", 1 ' adPersistXML
rs.Close
cn.Close
End Sub
keepITcool
< email : keepitcool chello nl (with @ and .) >
< homepage:
http://members.chello.nl/keepitcool >