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

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,026
Excel Vers. ve Dili
Office 2019 (64 bit) - Türkçe
Ufak bi'revizyon... Problem devam ederse dosya uzantılarını kontrol edin.

C++:
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

Altın Üye
Altın Üye
Katılım
10 Ocak 2011
Mesajlar
42
Excel Vers. ve Dili
2007
Ufak bi'revizyon... Problem devam ederse dosya uzantılarını kontrol edin.

C++:
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
 

Ekli dosyalar

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
9,669
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
Satırın sonundaki parantez karakterini silip, deneyin...

.
 

mrkaan

Altın Üye
Altın Üye
Katılım
10 Ocak 2011
Mesajlar
42
Excel Vers. ve Dili
2007
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

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,859
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
.

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. :)
.
 

mrkaan

Altın Üye
Altın Üye
Katılım
10 Ocak 2011
Mesajlar
42
Excel Vers. ve Dili
2007
.

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. :)
.

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