Sub Convert_Excel_Data_to_XML()
Dim oMyconnection As Connection
Dim oMyrecordset As Recordset
Dim oMyXML As DOMDocument
Dim oMyWorkbook As String
Set oMyconnection = New Connection
Set oMyrecordset = New Recordset
Set oMyXML = New DOMDocument
oMyWorkbook = Application.ThisWorkbook.FullName
oMyconnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & oMyWorkbook & ";" & _
"Extended Properties=excel 8.0;" & _
"Persist Security Info=False"
oMyrecordset.Open "Select * from [Sheet1$A1:D43]", oMyconnection, adOpenStatic
oMyrecordset.save oMyXML, adPersistXML
oMyXML.save (ThisWorkbook.Path & "\Output.xml")
oMyrecordset.Close
Set oMyconnection = Nothing
Set oMyrecordset = Nothing
Set oMyXML = Nothing
End Sub