XML Dosyasından istediğim veriyi çekme

[berkem13]

Merhaba üstatlarım, elimde 200'den fazla e-fatura mevcut. Hepsine tek tek bakıp, tek tek mal hizmet kodlarını ve açıklamalarını kopyalamak artık zulüm haline geldi.
Excel'de "İçeri Aktar" modülü ile xml'i aktardığımda XML dosyasında bulunan tüm verileri önüme getiriyor. Benim isteğim:
200 Faturayı toplu olarak içeri aktar dediğimde sadece ns4:Item ögesini toplu şekilde göstermesi. Umarım derdimi anlatabilmişimdir. Şimdiden yapacağınız yorumlardan dolayı teşekkür ederim.

 

[Erdem Akdemir]

Örnek bir xml ekleyebilir misiniz.
Görünmesini istemediğiniz veriler için xml'i notepad ile açıp, içini düzenleyebilirsiniz.

 

[berkem13]

Örnek bir xml ekleyebilir misiniz.
Görünmesini istemediğiniz veriler için xml'i notepad ile açıp, içini düzenleyebilirsiniz.

Üstadım, dediğim gibi 200'den fazla xml var. Bundan dolayı tek tek girip düzenlemek çok zorluyor bizi.

Ek: https://www.dosyaupload.com/odlI

 

[Erdem Akdemir]

Altın üye olduğunuz için sitenin dosya yükleme özelliğini kullanabilirsiniz.
Fatura PDF'i üzerinden yada resim olarak'ta olabilir,istediğiniz alanları görmek lazım.

 

[berkem13]

Altın üye olduğunuz için sitenin dosya yükleme özelliğini kullanabilirsiniz.
Fatura PDF'i üzerinden yada resim olarak'ta olabilir. İstediğiniz alanları görmek lazım.

XML Desteklemiyor hatası aldım hocam. Ondan dolayı dosyaupload sitesinde ekledim.

Malzeme No ve Tanım sütununu istiyorum hocam.

 

[Erdem Akdemir]

Merhaba,

Aşağıdaki kodu bir modüle kopyalayın. Excel dosyanızı xml'lerin olduğu klasöre ekledikten sonra kodu çalıştırabilirsiniz.
Fatura'da birden fazla malzeme varsa kod değişecektir. Bunun için xml yapısını görmek gerekiyor.

Sub berkem()

    Cells.Clear
    Dim xDoc As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    
    yol = ThisWorkbook.Path & "\"
    
    dosya = Dir(yol & "*" & ".xml", vbNormal)
    
    If dosya = "False" Then Exit Sub
    x = 1
    
    Do
          
    xDoc.Load yol & dosya
    
    Set Malzeme = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cac:Item/cbc:Name")
    Set Tanim = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cac:Item/cac:SellersItemIdentification/cbc:ID")
    Set Fatura = xDoc.SelectNodes("//Invoice/cbc:ID")
    
    Cells(x, 1) = Tanim.Item(0).nodetypedvalue
    Cells(x, 2) = Malzeme.Item(0).nodetypedvalue
    Cells(x, 3) = Fatura.Item(0).nodetypedvalue
    
    x = x + 1
        
    dosya = Dir()
    
    Loop While dosya <> ""
 
Cells.EntireColumn.AutoFit

End Sub

 

[berkem13]

Merhaba,

Aşağıdaki kodu bir modüle kopyalayın. Excel dosyanızı xml'lerin olduğu klasöre ekledikten sonra kodu çalıştırabilirsiniz.
Fatura'da birden fazla malzeme varsa kod değişecektir. Bunun için xml yapısını görmek gerekiyor.

Sub berkem()

    Cells.Clear
    Dim xDoc As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
   
    yol = ThisWorkbook.Path & "\"
   
    dosya = Dir(yol & "*" & ".xml", vbNormal)
   
    If dosya = "False" Then Exit Sub
    x = 1
   
    Do
         
    xDoc.Load yol & dosya
   
    Set Malzeme = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cac:Item/cbc:Name")
    Set Tanim = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cac:Item/cac:SellersItemIdentification/cbc:ID")
    Set Fatura = xDoc.SelectNodes("//Invoice/cbc:ID")
   
    Cells(x, 1) = Tanim.Item(0).nodetypedvalue
    Cells(x, 2) = Malzeme.Item(0).nodetypedvalue
    Cells(x, 3) = Fatura.Item(0).nodetypedvalue
   
    x = x + 1
       
    dosya = Dir()
   
    Loop While dosya <> ""

Cells.EntireColumn.AutoFit

End Sub

Hocam çok sağolun. Faturaların çoğunda birden fazla mal var. Mantığını az çok anladım ancak ekteki xml ve pdf'e de bakarsanız çok mutlu olurum.

Xml: https://www.dosyaupload.com/k1dl

 

[Erdem Akdemir]

Tüm dosyaları zipleyerek siteye ekleyebilirsiniz.Xml dosyaları da eklenmiş olur.

 

[berkem13]

Tüm dosyaları zipleyerek siteye ekleyebilirsiniz.Xml dosyaları da eklenmiş olur.

Buyrun hocam.

 

[Erdem Akdemir]

Deneyiniz.

Sub berkem()

    Cells.Clear
    Dim xDoc As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    
    yol = ThisWorkbook.Path & "\"
    
    dosya = Dir(yol & "*" & ".xml", vbNormal)
    
    If dosya = "False" Then Exit Sub
    x = 1
    
    Do
    
    xDoc.Load yol & dosya
    
    Set Malzeme = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cac:Item/cbc:Name")
    Set Tanim = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cac:Item/cac:SellersItemIdentification/cbc:ID")
    Set Fatura = xDoc.SelectNodes("//Invoice/cbc:ID")
      
    For i = 0 To Malzeme.Length - 1
    
    Cells(x, 1) = Tanim.Item(i).nodetypedvalue
    Cells(x, 2) = Malzeme.Item(i).nodetypedvalue
    Cells(x, 3) = Fatura.Item(0).nodetypedvalue
    
    x = x + 1
    Next i
          
    dosya = Dir()
    
    Loop While dosya <> ""
 
Cells.EntireColumn.AutoFit

End Sub

 

[berkem13]

Hocam excelde "object variable or with block variable not set" hatası alıyorum. Sadece 30 faturanın bilgilerini getiriyor. Sonra da bu hatayı veriyor.

 

[berkem13]

Hocam excelde "object variable or with block variable not set" hatası alıyorum. Sadece 30 faturanın bilgilerini getiriyor. Sonra da bu hatayı veriyor.

Sorunu çözdüm hocam.

 

[mehmetd]

Sn. Erdem Bey iyi akşamlar. Yukarıda verdiğiniz kodu kendi faturam için uygulamaya çalıştım yapamadım. sizden ricam ek.teki dosyaya uygun olarak ekteki xml faturayı aktarmayı gerçekleştirecek bir koda ihtiyacım var. Şimdiden yardımlarınız için teşekkürler.

 

[Asri]

Sorunu çözdüm hocam.

Sorunu çözmeniz güzel. Nasıl çözdüğünüzü yazarsanız bu sorunu yaşayanlarda faydalanmış olur.

 

[mehmetd]

Sn. Berkem Bey günaydın. Aynı sorun bende de var. nasıl çözdünüz kullandığınız kodları paylaşabilirseniz duacınız olurum. Saygılarımla.iyi çalışmalar.

 

[mehmetd]

Sn. Erdem bey iyi günler konu hakkında yardımınızı rica ediyorum. benim için çok önemli bir mesele. Verdiğiniz kodu uyguluyorum benim xml dosyamda çalışmıyor.Saygılarımla.İyi çalışmalar

 

[berkem13]

Sorunu çözmeniz güzel. Nasıl çözdüğünüzü yazarsanız bu sorunu yaşayanlarda faydalanmış olur.

Sn. Berkem Bey günaydın. Aynı sorun bende de var. nasıl çözdünüz kullandığınız kodları paylaşabilirseniz duacınız olurum. Saygılarımla.iyi çalışmalar.

Sn. Erdem bey iyi günler konu hakkında yardımınızı rica ediyorum. benim için çok önemli bir mesele. Verdiğiniz kodu uyguluyorum benim xml dosyamda çalışmıyor.Saygılarımla.İyi çalışmalar

Mesajlarını şimdi gördüm. Kusura bakmayın. Her E-Fatura'nın xml tanımları farklı olabileceği için xml dosyalarında tanımları bulup @Erdem_34 üstadımın hazırladığı makroda değiştirmek yeterli oluyor. @mehmetd sizin faturanız için aşağıdaki makro düzgün bir şekilde çalışıyor hocam. Test edebilirsiniz.

Sub mehmetd()

    Cells.Clear
    Dim xDoc As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    
    yol = ThisWorkbook.Path & "\"
    
    dosya = Dir(yol & "*" & ".xml", vbNormal)
    
    If dosya = "False" Then Exit Sub
    x = 1
    
    Do
    
    xDoc.Load yol & dosya
    
    Set Malzeme = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cac:Item/cbc:Name")
    Set Tanim = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cbc:ID")
    Set Fatura = xDoc.SelectNodes("//Invoice/cbc:ID")
      
    For i = 0 To Malzeme.Length - 1
    
    Cells(x, 1) = Tanim.Item(i).nodetypedvalue
    Cells(x, 2) = Malzeme.Item(i).nodetypedvalue
    Cells(x, 3) = Fatura.Item(0).nodetypedvalue
    
    x = x + 1
    Next i
          
    dosya = Dir()
    
    Loop While dosya <> ""
 
Cells.EntireColumn.AutoFit

End Sub

 

[ERRİC]

Merhabalar, yukarıdaki makro ile xml faturalardan excele veri çekilmektedir, sorum şu ekteki excelime aynı şekilde sarıya boyadığım alanlar gibi
verileri çekmek mümkün mü acaba; tablonun sadece sarı kısımlarına, xml faturaların olduğu klasörde bazen 50 tane bazen 350 tane fatura olabiliyor; Saygılar

 

[ERRİC]

Günaydınlar uygun olanlar bakabilirler mi acaba

 

[ERRİC]

merhabalar bu aşağıdaki kod ile ayrı bir excele en azından döküm alabiliyoruz @berkem13 yazdığı koda bir satır daha ekledim miktarlar geliyor; fakat birimler yani kg, adet, m, v.b bunlar gelmiyor en azından bu birimlerde gelse excele; bu excel ile diğer excelimi birleştirebilirim;
birim kodlarının da gelmesi için nası bir kod yazılabilir acaba;

Sub mehmetd()

    Cells.Clear
    Dim xDoc As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    
    yol = ThisWorkbook.Path & "\"
    
    dosya = Dir(yol & "*" & ".xml", vbNormal)
    
    If dosya = "False" Then Exit Sub
    x = 1
    
    Do
    
    xDoc.Load yol & dosya
    
    Set Malzeme = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cac:Item/cbc:Name")
    Set Tanim = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cbc:ID")
    Set Fatura = xDoc.SelectNodes("//Invoice/cbc:ID")
    Set Miktar = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cbc:InvoicedQuantity")

    For i = 0 To Malzeme.Length - 1
    
    Cells(x, 1) = Tanim.Item(i).nodetypedvalue
    Cells(x, 2) = Malzeme.Item(i).nodetypedvalue
    Cells(x, 3) = Fatura.Item(0).nodetypedvalue
    Cells(x, 4) = Miktar.Item(i).nodetypedvalue

    x = x + 1
    Next i
          
    dosya = Dir()
    
    Loop While dosya <> ""
 
Cells.EntireColumn.AutoFit

End Sub