Exporterer til xml

Håber du selv kan lave noget :-)

I ark2 har du en liste med 6 kolonner (Afd,navn, stilling,tlf,email og sti til billede) og derunder har alle ansatte.
Overskrifter i A1:F1 og ansatte nedad derfra.

Denne makro kan så lave eksporten til en xlm-fil

Sub MakeXMLfile()
  Dim objXMLDOM As Object  'DOMDocument40
  Dim objPI As Object  'IXMLDOMProcessingInstruction
  Dim objListe As Object
  Dim wsh As Worksheet
  Dim rngData As Range
  Dim rngCell As Range

  Set wsh = Worksheets("Data")
  'opret forbindelse til XML-objectet
  Set objXMLDOM = CreateObject("Microsoft.XMLDOM")
  'lav processing-instruktioner
  Set objPI = objXMLDOM.createProcessingInstruction( _
              "xml", "version='1.0' encoding='UTF-8'")
  'find antallet af rækker, der skal eksporteres
  Set rngData = wsh.Range("A2:A" & wsh.Range("A65536").End(xlUp).Row)
  'opret elementet PERSONALE
  Set objXMLDOM.documentElement = objXMLDOM.createElement("Personale")
  'Opret elementet LISTE
  Set objListe = objXMLDOM.createElement("Liste")
  'Indsæt Processing instruktioner
  objXMLDOM.insertBefore objPI, objXMLDOM.childNodes.Item(0)
  'opret resten af elementerne
  objListe.appendChild objXMLDOM.createElement("Afdeling")
  objListe.appendChild objXMLDOM.createElement("Navn")
  objListe.appendChild objXMLDOM.createElement("Stilling")
  objListe.appendChild objXMLDOM.createElement("Telefon")
  objListe.appendChild objXMLDOM.createElement("Email")
  objListe.appendChild objXMLDOM.createElement("Billede")
  'indsæt underelementerne fra excel i listen
  For Each rngCell In rngData
      objListe.childNodes(0).Text = rngCell.Text
      objListe.childNodes(1).Text = rngCell.Offset(, 1).Text
      objListe.childNodes(2).Text = rngCell.Offset(, 2).Text
      objListe.childNodes(3).Text = rngCell.Offset(, 3).Text
      objListe.childNodes(4).Text = rngCell.Offset(, 4).Text
      objListe.childNodes(5).Text = rngCell.Offset(, 5).Text
      'indsæt dem
      objXMLDOM.documentElement.appendChild objListe.CloneNode(True)
  Next
  'Gem som XML-fil
  objXMLDOM.Save (ThisWorkbook.Path & "\myXML1.xml")
  'Ryd op
  Set objPI = Nothing
  Set objXMLDOM = Nothing
  Set objListe = Nothing
End Sub

I øvrig ser det lidt mærkeligt ud at din xml begynder med <personale> og afsluttes med </afdeling>.

En ordentlig smøre, jeg prøver lige... Vender tilbage...

hmm jeg får en Out of range - error.

Det skal lige siges at jeg aner intet om makro-programmering...

ups - Det er en 'Subscript Out of Range' jeg får

her er min test. koden er lidt anderledes

www.tbdl.dk/excel/xml-ansatte.xls

Den ser sgu særdeles meget brugbar ud, men hvis jeg sletter en post, så opdaterer den ikke i xml'en, når jeg exporterer.

Jo, do skal bare trykke på knappen igen, så overskriver den xml-filen

Du har sørme ret :) Ved ikke lige hvorfor den ikke opdaterede i IE...

Hej bak!
Når der skal være flere niveauer i xml-filen, er nedenstående så den bedste måde at gøre det på (med et yderligere objekt):

...

'Opret elementet LISTE
Set objListe = objXMLDOM.createElement("Liste")
'opret resten af elementerne
objListe.appendChild objXMLDOM.createElement("Afdeling")
objListe.appendChild objXMLDOM.createElement("Navn")
objListe.appendChild objXMLDOM.createElement("Stilling")

'Opret elementet HALLO
Set objHallo = objXMLDOM.createElement("Hallo")
'opret resten af elementerne
objHallo.appendChild objXMLDOM.createElement("Telefon")
objHallo.appendChild objXMLDOM.createElement("Email")
objHallo.appendChild objXMLDOM.createElement("Billede")

'indsæt underelementerne fra excel i listen
For Each rngCell In rngData
    objListe.childNodes(0).Text = rngCell.Text
    objListe.childNodes(1).Text = rngCell.Offset(, 1).Text
    objListe.childNodes(2).Text = rngCell.Offset(, 2).Text
    'indsæt dem
    objXMLDOM.documentElement.appendChild objListe.CloneNode(True)

    objHallo.childNodes(0).Text = rngCell.Offset(, 3).Text
    objHallo.childNodes(1).Text = rngCell.Offset(, 4).Text
    objHallo.childNodes(2).Text = rngCell.Offset(, 5).Text
    'indsæt dem
    objXMLDOM.documentElement.appendChild objHallo.CloneNode(True)
Next

...

Hvis du skulle have et eksempel ved hånden på en anden, mere fornuftig måde at gøre det på er der også 100 pt fra mig.

Ok - mit eks viser ikke et ekstra niveau. Det er egentlig det jeg er ude efter!

bak
Vil du være så venlig at lægge et svar ind, så du kan få dine point af mig. Din kode var noget jeg absolut kunne bruge :)

Ok, det var godt.
Brynil -> Vil du have et ekstra niveau, eller har du grejet det selv ?

Hej bak!
Meget gerne, jeg kan ikke få det til at funke når jeg laver loopet. Den smider kun data rigtigt ind under det første gennemløb.
Min indsigt i DOM er begrænset, så hvis du vil, smider jeg points i et spm til dig.

Iøvrigt, jeg har været hele nettet igennem og talt med boghandlere om noget vb(a)/DOM uden held. Du skulle vel ikke kende en fornuftig kilde?

Bortset fra Eksperten, selvfølgelig ;-)