xml dosyasından excele belli kriterlere göre veri çekmek

[Zeki Gürsoy]

Ufak bi'revizyon... Problem devam ederse dosya uzantılarını kontrol edin.

Sub Test2()
    'Haluk - 04/04/2021
    'E-Posta: sa4truss@gmail.com
    '
    Dim FSO As Object, xDoc As Object, MyFolder As Object
    Dim FileItem As Variant, SourceFolder As Object, MyFile As String, xElement As Object
    Dim i As Integer, j As Integer, myMsg As String, strFile As String
    
    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    
    Set MyFolder = Application.FileDialog(msoFileDialogFolderPicker)
    
    If MyFolder.Show <> 0 Then
        Set SourceFolder = FSO.GetFolder(MyFolder.SelectedItems(1))
    Else
        myMsg = "XML formatında faturaların olduğu klasörü seçmelisiniz....."
        GoTo SafeExit:
    End If
    
    strFile = Dir(MyFolder.SelectedItems(1) & "\*.xml")
    
    Do While strFile <> ""
        i = Range("A" & Rows.Count).End(xlUp).Row + 1
        j = j + 1
        
        xDoc.Load MyFolder.SelectedItems(1) & "\" & strFile )
        
        Set xElement = xDoc.SelectSingleNode("//cac:AdditionalDocumentReference/cbc:IssueDate")
        Range("A" & i) = xElement.Text
        
        Set xElement = xDoc.SelectSingleNode("//cac:Party/cac:PartyName")
        Range("B" & i) = xElement.Text
        
        Set xElement = xDoc.SelectSingleNode("//cac:TaxTotal/cac:TaxSubtotal/cbc:Percent")
        Range("C" & i) = xElement.Text
        
        Set xElement = xDoc.SelectSingleNode("//cac:TaxTotal/cbc:TaxAmount")
        Range("D" & i) = xElement.Text
        
        Set xElement = xDoc.SelectSingleNode("//cac:TaxTotal/cac:TaxSubtotal/cbc:TaxableAmount")
        Range("E" & i) = xElement.Text
        
        Set xElement = xDoc.SelectSingleNode("//cac:LegalMonetaryTotal/cbc:TaxInclusiveAmount")
        Range("F" & i) = xElement.Text
        
        strFile = Dir
    Loop

    If j = 0 Then
        myMsg = "Klasörde hiçbir XML dosyası bulunamadı....."
        GoTo SafeExit:
    Else
        myMsg = "Sayin " & Environ("UserName") & "; " & j & " adet dosyadan veriler alındı...."
    End If
    
SafeExit:
    MsgBox myMsg, vbInformation
    Set xElement = Nothing
    Set xDoc = Nothing
End Sub

 

[mrkaan]

Ufak bi'revizyon... Problem devam ederse dosya uzantılarını kontrol edin.

Sub Test2()
    'Haluk - 04/04/2021
    'E-Posta: sa4truss@gmail.com
    '
    Dim FSO As Object, xDoc As Object, MyFolder As Object
    Dim FileItem As Variant, SourceFolder As Object, MyFile As String, xElement As Object
    Dim i As Integer, j As Integer, myMsg As String, strFile As String
   
    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
   
    Set MyFolder = Application.FileDialog(msoFileDialogFolderPicker)
   
    If MyFolder.Show <> 0 Then
        Set SourceFolder = FSO.GetFolder(MyFolder.SelectedItems(1))
    Else
        myMsg = "XML formatında faturaların olduğu klasörü seçmelisiniz....."
        GoTo SafeExit:
    End If
   
    strFile = Dir(MyFolder.SelectedItems(1) & "\*.xml")
   
    Do While strFile <> ""
        i = Range("A" & Rows.Count).End(xlUp).Row + 1
        j = j + 1
       
        xDoc.Load MyFolder.SelectedItems(1) & "\" & strFile )
       
        Set xElement = xDoc.SelectSingleNode("//cac:AdditionalDocumentReference/cbc:IssueDate")
        Range("A" & i) = xElement.Text
       
        Set xElement = xDoc.SelectSingleNode("//cac:Party/cac:PartyName")
        Range("B" & i) = xElement.Text
       
        Set xElement = xDoc.SelectSingleNode("//cac:TaxTotal/cac:TaxSubtotal/cbc:Percent")
        Range("C" & i) = xElement.Text
       
        Set xElement = xDoc.SelectSingleNode("//cac:TaxTotal/cbc:TaxAmount")
        Range("D" & i) = xElement.Text
       
        Set xElement = xDoc.SelectSingleNode("//cac:TaxTotal/cac:TaxSubtotal/cbc:TaxableAmount")
        Range("E" & i) = xElement.Text
       
        Set xElement = xDoc.SelectSingleNode("//cac:LegalMonetaryTotal/cbc:TaxInclusiveAmount")
        Range("F" & i) = xElement.Text
       
        strFile = Dir
    Loop

    If j = 0 Then
        myMsg = "Klasörde hiçbir XML dosyası bulunamadı....."
        GoTo SafeExit:
    Else
        myMsg = "Sayin " & Environ("UserName") & "; " & j & " adet dosyadan veriler alındı...."
    End If
   
SafeExit:
    MsgBox myMsg, vbInformation
    Set xElement = Nothing
    Set xDoc = Nothing
End Sub

merhabalar zeki bey kod için teşekkürler çalıştır dedigimde bu hatayı verdi

 

[Haluk]

Satırın sonundaki parantez karakterini silip, deneyin...

.

 

[mrkaan]

evet şuan çalıştı teşekkür ediyorum tekrardan şimdi ben birden fazla kdv oldugundaki kombinasyonu ugrasıcam sizi çok ugrastırdım hakkınızı helal edin.

 

[Emir Hüseyin Çoban]

.

Merhaba,
yıllar önce böyle bir çalışmaya ihtiyacım olmuştu.
Yapılabileceğini biliyordum ama elimde döküman yoktu.
Konuyu arşivime alıyorum. Teşekkürler...

Biz bu destekleri göremedik, incindim.

XML' den Veri Alma Hk.

. . . Merhaba Arkadaşlar, Elimde XML ve Xslt verileri olan bir çok e-fatura dosyası var. Bu dosya biçimleri içinden hangisi daha kolay olacaksa belirli alanlardan excele veri çekmek istiyorum. E-faturanın görüntüsü şu şekilde... Bu dosyanın XML' inden e-fatura no - ürün ismi - miktar kg...

www.excel.web.tr

.

 

[mrkaan]

.

Merhaba,
yıllar önce böyle bir çalışmaya ihtiyacım olmuştu.
Yapılabileceğini biliyordum ama elimde döküman yoktu.
Konuyu arşivime alıyorum. Teşekkürler...

Biz bu destekleri göremedik, incindim.

XML' den Veri Alma Hk.

. . . Merhaba Arkadaşlar, Elimde XML ve Xslt verileri olan bir çok e-fatura dosyası var. Bu dosya biçimleri içinden hangisi daha kolay olacaksa belirli alanlardan excele veri çekmek istiyorum. E-faturanın görüntüsü şu şekilde... Bu dosyanın XML' inden e-fatura no - ürün ismi - miktar kg...

www.excel.web.tr

.

inanın biraz bilgim olsa elimden gelen yardımı yapardım size bende sordum sağolsunlar yardımcı oldular

 

[cozgun]

evet şuan çalıştı teşekkür ediyorum tekrardan şimdi ben birden fazla kdv oldugundaki kombinasyonu ugrasıcam sizi çok ugrastırdım hakkınızı helal edin.

Merhaba,
Birden fazla kdv olan durumu çözebildiniz mi, ben de burada takıldım da. ÖTV nin çekilmesi de yine gerekecek benzer şekilde.

 

[KarıncaZ]

Merhaba.
Tamamen yapay zekaya yaptırdığım dosya linktedir.

Dosya

XML_Fatura_Raporu_Guncel_Rev02 Makrosunu çalıştırın. Ben fil resmine atama yapmıştım.

Faturanın genel toplamlarını, KDV oranlarına göre dağılımını Faturalar sayfasına yazıyor ve Fark başlığı altında uygun olmayan faturaların farklarını yazıyor. Yani Genel toplam ile KDV oranlarına göre dağılımı topluyor arada fark varsa yazıyor.

Her faturanın satırlarındaki bilgileri de Detay sayfasına yazıyor. Her bir faturayı da detaylı olarak buradan filtreleyerek görebilirsiniz.

Ben çalıştırdığımda
1-) Market faturalarında birden fazla KDV olduğunda Matrahlar tutmuyor ama bu sorun XML i hatalı okumasından değil gerçekten fatura detaylarındaki matrahları KDV oranlarına göre topladığınızda uyumsuzluk var.
2-) Konaklama vergisinin olduğu faturalarda uyumsuzluk var.
3-) Öiv yada Ötv içeren faturalarda uyumsuzluk var.
Denemesini yaptığım 150 faturada sadece bu üç unsuru içeren faturaların hatalı geldiğini gördüm. Diğerlerinde hataya rastlamadım.

Umarım faydası olur.