XML Çıktısı Almak

[EverQuesT]

Elimdeki excel dosyasında 5 sayfa mevcut. Bunun 3 sayfasını ayrı ayrı xml çıktısını almak istiyorum makro ile tuş yapılsa tuşa bastığında xml çıktısını otomatik üretebilse. Yardımcı olabilecek biri var ise mail olarak dosyayı ve istediğim çıktı şeklini atabilirim çok teşekkür ederim.

 

[EverQuesT]

Yardımcı olabilecek kimse yokmu

 

[EverQuesT]

Değerli dostlar bilen arkadaşımız yok mudur?

 

[veyselemre]

Dosyanızı link vererek paylaşırsanız, birileri mutlaka yardımcı olacaktır, bu şekilde ne istediğinizi bilmeden yardımcı olmak zor.

 

[EverQuesT]

Dosyanızı link vererek paylaşırsanız, birileri mutlaka yardımcı olacaktır, bu şekilde ne istediğinizi bilmeden yardımcı olmak zor.

http://bit.ly/1RU4enH

dosya budur.
gg, ggdetay ve n11 dosyalarının xml çıktısını alacağız.

çıktı örneği bu şekildedir.
http://bit.ly/1KUSoo7

 

[veyselemre]

Referanslardan Microsoft XML işaretli olmalıdır.
Kodu deneyin.

Sub Create_XML()
    If ActiveSheet.Name <> "n11" Then Exit Sub
    Dim objDom As DOMDocument
    Dim objRootElem As IXMLDOMElement
    Dim objRowElem As IXMLDOMElement
    Dim objChildElem(1 To 10) As IXMLDOMElement

    Set objDom = New DOMDocument

    Set objRootElem = objDom.createElement("Root")
    objRootElem.setAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
    objDom.appendChild objRootElem

    For sat = 1 To Cells(Rows.Count, 1).End(3).Row
        Set objRowElem = objDom.createElement("Row")
        For sut = 1 To 10
            If Cells(sat, sut) <> Empty Then
                Set objChildElem(sut) = objDom.createElement(Cells(1, sut))
                objChildElem(sut).Text = Cells(sat, sut)
                objRowElem.appendChild objChildElem(sut)
            End If
        Next sut
        objRootElem.appendChild objRowElem
    Next sat
    
    objDom.Save ("d:\n11.xml")
    
    Set objDom = Nothing
    Set objRootElem = Nothing
    Set objRowElem = Nothing
    Erase objChildElem
    
End Sub

 

[veyselemre]

Aşağıdaki kodla 3 sayfayın xml dokumunu D dizinine sayfa ismiyle oluşturur.

Sub Create_XML()

    Dim objDom As DOMDocument
    Dim objRootElem As IXMLDOMElement
    Dim objRowElem As IXMLDOMElement
    Dim objChildElem(1 To 10) As IXMLDOMElement


    For Each sayfa In Array("n11", "gg", "ggdetay")
        Set objDom = New DOMDocument

        Set objRootElem = objDom.createElement("Root")
        objRootElem.setAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
        objDom.appendChild objRootElem

        Sheets(sayfa).Select

        For sat = 1 To Cells(Rows.Count, 1).End(3).Row
            Set objRowElem = objDom.createElement("Row")
            For sut = 1 To 10
                If Cells(sat, sut) <> Empty Then
                    Set objChildElem(sut) = objDom.createElement(Cells(1, sut))
                    objChildElem(sut).Text = Cells(sat, sut)
                    objRowElem.appendChild objChildElem(sut)
                End If
            Next sut
            objRootElem.appendChild objRowElem
        Next sat
        objDom.Save ("d:\" & sayfa & ".xml")

        Set objDom = Nothing
        Set objRootElem = Nothing
        Set objRowElem = Nothing
        Erase objChildElem
    Next sayfa

End Sub

 

[EverQuesT]

Teşekkürler.

 

[levo26]

Veysel bey;
Kod içinde yer alan;
objRootElem.setAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"

esprisi nedir. İnternet sayfası gibi...