Pasar de xls a xml

[Pax-Man]

Presisamente el metodo de importacion de excel es demasiado ineficiente, mucho codigo basura queda en mi documento, pues por eso he estado pensando en lo de la macro para crearlo... y bueno logre lleagr a esta solucion

y coloco la macro para que le sea algo util a otras personas, quizas el codigo pueda mejorarse... es la primera prueba

Código:

Sub toXML()
Dim strNombreArchivo, strRuta, strArchivoTexto As String
Dim f As Integer
strNombreArchivo = "mixml.xml"
strRuta = "C:\"
strArchivoTexto = strRuta & strNombreArchivo

'abrimos el archivo para escribir
f = FreeFile
Open strArchivoTexto For Output As #f

'Encabezado del Archivo
Print #f, "<?xml version='1.0' encoding='UTF-8'?>"

'escribimos al archivo
Print #f, "<categoria>"
    Nombre = ActiveSheet.Name
    Set X = Worksheets(Nombre)
    With X
        Fila = Range("A65000").End(xlUp).Row
        For I = 1 To Fila
            If Trim(Range("A" & I).Value) = "tema" Then
                temaid = Trim(Range("H" & I).Value)
            End If
            If Range("D" & I).Value <> "" And Range("F" & I).Value <> "" And Trim(Range("G" & I).Value) <> "***" Then
                Print #f, "<usuario>"
                Print #f, "<codigo>" & Cliente_cod & "</codigo>"
                Print #f, "<documento>" & Trim(.Range("E" & I).Value) & "</documento>"
                Print #f, "<fecha>" & Range("M" & I).Value & "</fecha>"
                Print #f, "<vencimiento>" & Range("N" & I).Value & "</vencimiento>"
                Print #f, "<nick>" & Range("O" & I).Value & "</nick>"
                Print #f, "</usuario>"
            End If
        Next I
    End With

'Footer del Archivo
Print #f, "</categoria>"

'cerramos el archivo de texto
Close f
End Sub