Çözüldü Resmi Tatiller .evn kaydet

[k0081]

Merhaba arkadaşlar

İndir Resmi Tatiller

Dosyayı indir Resmi Tatiller

dosya.co

linkte vermiş olduğum excel tablosundaki verileri *.evn dosyası olarak nasıl kaydedebilirim ?

örnek *.evn dosyası da ekte verilmiş olup, sadece iki kısım veri girilmiştir... ( yılbaşı ve ramazan bayramı arifesi )

yardımcı arkadaşa şimdiden teşekkürler.

 

[Haluk]

Sub Test()
    'Haluk - 20/03/2023
    '
    Dim xDoc As Object, myNode As Object
    Dim MyFile As String, new_FileName As String, i As Integer, NoC As Integer
    Dim XML_FileName As String
    
    XML_FileName = ThisWorkbook.Path & Application.PathSeparator & "ResmiTatiller.evn"
    
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    xDoc.resolveExternals = True
    
    Set objRoot = xDoc.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
    Set objRoot = xDoc.InsertBefore(objRoot, xDoc.ChildNodes.Item(0))
    Set objRoot = xDoc.createElement("Table")
    Set xDoc.DocumentElement = objRoot
    
    NoC = Range("C" & Rows.Count).End(xlUp).Row
    
    Set myNode = xDoc.SelectSingleNode("//Table")
    
    Set ba_ChildNode = xDoc.createElement("Name")
    myNode.appendChild (ba_ChildNode)
    ba_ChildNode.Text = "Polska"
    
    For i = 2 To NoC
        Set ba_ChildNode = xDoc.createElement("Records")
        myNode.appendChild (ba_ChildNode)
                
        Set new_ba_ChildNode = xDoc.createElement("Day")
        new_ba_ChildNode.Text = Day(Split(Range("D" & i), ",")(1))
        ba_ChildNode.appendChild (new_ba_ChildNode)
        
        Set new_ba_ChildNode = xDoc.createElement("Month")
        new_ba_ChildNode.Text = Month(Split(Range("D" & i), ",")(1))
        ba_ChildNode.appendChild (new_ba_ChildNode)
        
        Set new_ba_ChildNode = xDoc.createElement("Year")
        new_ba_ChildNode.Text = Year(Split(Range("D" & i), ",")(1))
        ba_ChildNode.appendChild (new_ba_ChildNode)
        
        Set new_ba_ChildNode = xDoc.createElement("Opis")
        new_ba_ChildNode.Text = Range("C" & i)
        ba_ChildNode.appendChild (new_ba_ChildNode)
        
        Set new_ba_ChildNode = xDoc.createElement("Plik")
        new_ba_ChildNode.Text = "null"
        ba_ChildNode.appendChild (new_ba_ChildNode)
        
        Set new_ba_ChildNode = xDoc.createElement("Oty")
        new_ba_ChildNode.Text = "true"
        ba_ChildNode.appendChild (new_ba_ChildNode)
    Next
    
    xDoc.Save (XML_FileName)
    
    Set myNode = Nothing
    Set new_ba_ChildNode = Nothing
    Set ba_ChildNode = Nothing
    Set objRoot = Nothing
    Set xDoc = Nothing
End Sub

.

 

[k0081]

@Haluk

Hocam tek kelime ile Süper.!

Çok Teşekkür ediyorum. Tamamdır.