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

mrkaan

Altın Üye
Altın Üye
Katılım
10 Ocak 2011
Mesajlar
42
Excel Vers. ve Dili
2007
merhaba arkadaşlar xml uzantılı bir faturadan istediğim kriterlere göre veri nasıl aktarabilirim mesela tarih no firma adı matrah kdv toplam olarak belirli bir formülü varmı yardımcı olursanız sevinirim.
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
9,669
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
Forumda arama yaparsanız, benzer konulara ulaşabilirsiniz. Örnek bir XML dosyası eklemenizde de fayda var...

.
 

mrkaan

Altın Üye
Altın Üye
Katılım
10 Ocak 2011
Mesajlar
42
Excel Vers. ve Dili
2007
hem xml hem html olarak attım dosyaları ekledim

istediğim şey excel ortamına aktarmak aşagıda örnek olarak yazdım

a sütunu = ödeme tarihi ( sağ üstte yazıyor)
b sütunu = satıcı firma (aktug fırat) sol üst
c sütunu= kdv matrahı %18 ( 25,34)
d sütunu = kdv (4,56)
e sütunu= genel toplam ( 29,90)
 

Ekli dosyalar

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
9,669
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
Sonuçları Msgbox ile gösterdim, siz sayfada nereye istiyorsanız yazdırırsınız...

C#:
Sub Test()
    'Haluk - 04/04/2021
    'E-Posta: sa4truss@gmail.com
    '
    Dim xDoc As Object, MyFile As Variant, xElement As Object
    
    MyFile = Application.GetOpenFilename("E-Fatura (*.xml), *.xml")
    If MyFile = False Then Exit Sub
    
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    
    xDoc.Load MyFile
    
    Set xElement = xDoc.SelectSingleNode("//cac:AdditionalDocumentReference/cbc:IssueDate")
    MsgBox "Ödeme Tarihi: " & xElement.Text
    
    Set xElement = xDoc.SelectSingleNode("//cac:Party/cac:PartyName")
    MsgBox "Satıcı Firma: " & xElement.Text
    
    Set xElement = xDoc.SelectSingleNode("//cac:TaxTotal/cac:TaxSubtotal/cbc:Percent")
    MsgBox "KDV Oranı: " & xElement.Text
    
    Set xElement = xDoc.SelectSingleNode("//cac:TaxTotal/cbc:TaxAmount")
    MsgBox "KDV tutarı: " & xElement.Text
    
    Set xElement = xDoc.SelectSingleNode("//cac:TaxTotal/cac:TaxSubtotal/cbc:TaxableAmount")
    MsgBox "KDV matrahı: " & xElement.Text
    
    Set xElement = xDoc.SelectSingleNode("//cac:LegalMonetaryTotal/cbc:TaxInclusiveAmount")
    MsgBox "Genel Toplam: " & xElement.Text

    Set xElement = Nothing
    Set xDoc = Nothing
End Sub
.
 

mrkaan

Altın Üye
Altın Üye
Katılım
10 Ocak 2011
Mesajlar
42
Excel Vers. ve Dili
2007
Sonuçları Msgbox ile gösterdim, siz sayfada nereye istiyorsanız yazdırırsınız...

C#:
Sub Test()
    'Haluk - 04/04/2021
    'E-Posta: sa4truss@gmail.com
    '
    Dim xDoc As Object, MyFile As Variant, xElement As Object
   
    MyFile = Application.GetOpenFilename("E-Fatura (*.xml), *.xml")
    If MyFile = False Then Exit Sub
   
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
   
    xDoc.Load MyFile
   
    Set xElement = xDoc.SelectSingleNode("//cac:AdditionalDocumentReference/cbc:IssueDate")
    MsgBox "Ödeme Tarihi: " & xElement.Text
   
    Set xElement = xDoc.SelectSingleNode("//cac:Party/cac:PartyName")
    MsgBox "Satıcı Firma: " & xElement.Text
   
    Set xElement = xDoc.SelectSingleNode("//cac:TaxTotal/cac:TaxSubtotal/cbc:Percent")
    MsgBox "KDV Oranı: " & xElement.Text
   
    Set xElement = xDoc.SelectSingleNode("//cac:TaxTotal/cbc:TaxAmount")
    MsgBox "KDV tutarı: " & xElement.Text
   
    Set xElement = xDoc.SelectSingleNode("//cac:TaxTotal/cac:TaxSubtotal/cbc:TaxableAmount")
    MsgBox "KDV matrahı: " & xElement.Text
   
    Set xElement = xDoc.SelectSingleNode("//cac:LegalMonetaryTotal/cbc:TaxInclusiveAmount")
    MsgBox "Genel Toplam: " & xElement.Text

    Set xElement = Nothing
    Set xDoc = Nothing
End Sub
.


haluk bey teşekkür ederim şimdi açtım mesaj olarak sırasıyla geldi ekrana ama sütunlara eklemedi değerleri yada benmi hata yaptım acaba
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
9,669
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
Mesajımda yazmıştım, ben sonuçları ekrana MsgBox ile getirdim.... zaten işin önemli kısmı burası.

Gerisi, sizin Excel dosyanızda neyi nerde ne şekilde göstermenize bağlı olarak artık sizin kolaylıkla yapabilmeniz gereken şeyler.

.
 

mrkaan

Altın Üye
Altın Üye
Katılım
10 Ocak 2011
Mesajlar
42
Excel Vers. ve Dili
2007
tamam haluk bey sizin koda ilave yapacagım demi sütunlara koyması için birde mesela toplu fatura aktarımda yapabilirmiyim bunlarda
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
9,669
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
Klasördeki muhtelif XML dosyalarından verileri topluca Excel'e yazdırmak için; XML dosyalarını For-Next döngüsüyle ele alıp, her birinden verileri benzer şekilde almanız gerekiyor.

.
 

mrkaan

Altın Üye
Altın Üye
Katılım
10 Ocak 2011
Mesajlar
42
Excel Vers. ve Dili
2007
Klasördeki muhtelif XML dosyalarından verileri topluca Excel'e yazdırmak için; XML dosyalarını For-Next döngüsüyle ele alıp, her birinden verileri benzer şekilde almanız gerekiyor.

.

kodu for next ile revize edebilirmisiniz sizide ugrastırıyorum kusura bakmayın :(
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
9,669
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
Ücretli yardım isterseniz, özel mesajla görüşebiliriz....

.
 

mrkaan

Altın Üye
Altın Üye
Katılım
10 Ocak 2011
Mesajlar
42
Excel Vers. ve Dili
2007
valla sağa sola vermekten hiç bişey kalmadı mevcut kod içinde teşekkür ederim sağolun
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
9,669
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
Sağlık olsun ..... Siz de o zaman aşağıdaki revize kodu kullanın;

C#:
Sub Test()
    '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
    
    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
    
    For Each FileItem In SourceFolder.Files
        If FileItem.Type = "XML Document" Then
            i = Range("A" & Rows.Count).End(xlUp).Row + 1
            j = j + 1
        
            MyFile = FileItem.Path
            
            xDoc.Load MyFile
    
            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
        End If
    Next

    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

Altın Üye
Altın Üye
Katılım
10 Ocak 2011
Mesajlar
42
Excel Vers. ve Dili
2007
haluk bey çok teşekkür ediyorum size makro eğitimi için nerden başladınız bende eğitim almak istiyorum çok teşekkürler tekrardan
 

mrkaan

Altın Üye
Altın Üye
Katılım
10 Ocak 2011
Mesajlar
42
Excel Vers. ve Dili
2007
klasörü hedef gösteriyorum ıcınde xml dosyaları var ama hiç bi dosya bulunamadı diyor nedense ben kurcalıyim biraz bi şekilde hallolur
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
9,669
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
Sözkonusu XML dosyalarından birini sağ tıklayıp, çıkan menüden özellikler kısmını tıklayınca aşağıdaki resimde kırmızı okla işaretlediğim yerde ne yazıyor?

Capture.PNG


Eğer XML Document ifadesinden farklı birşeyse, kodda aşağıdaki satırda onu değiştirin, bir de öyle deneyin.....

Rich (BB code):
    For Each FileItem In SourceFolder.Files
        If FileItem.Type = "XML Document" Then
            i = Range("A" & Rows.Count).End(xlUp).Row + 1
            j = j + 1
.
 

mrkaan

Altın Üye
Altın Üye
Katılım
10 Ocak 2011
Mesajlar
42
Excel Vers. ve Dili
2007
Sözkonusu XML dosyalarından birini sağ tıklayıp, çıkan menüden özellikler kısmını tıklayınca aşağıdaki resimde kırmızı okla işaretlediğim yerde ne yazıyor?

Ekli dosyayı görüntüle 226611


Eğer XML Document ifadesinden farklı birşeyse, kodda aşağıdaki satırda onu değiştirin, bir de öyle deneyin.....

Rich (BB code):
    For Each FileItem In SourceFolder.Files
        If FileItem.Type = "XML Document" Then
            i = Range("A" & Rows.Count).End(xlUp).Row + 1
            j = j + 1
.





resimi ekledim haluk bey klasörü gösteriyorum klasörde xml bulunamadı diyor
 

Ekli dosyalar

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
9,669
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
XML Document yerine XML Dosyası yazıp, deneyin....

.
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
9,669
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
Aşağıda belirtilen kırmızı satırın yerine;

Rich (BB code):
 For Each FileItem In SourceFolder.Files
        If FileItem.Type = "XML Document" Then
            i = Range("A" & Rows.Count).End(xlUp).Row + 1
            j = j + 1

Bunu deneyin;

Rich (BB code):
    For Each FileItem In SourceFolder.Files
        If UCase(Right(FileItem.Name, 3)) = "XML" Then
            i = Range("A" & Rows.Count).End(xlUp).Row + 1
            j = j + 1
.
 
Üst