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

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,367
Excel Vers. ve Dili
Office 365 (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
 
Katılım
10 Ocak 2011
Mesajlar
48
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
29/12/2022
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
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Satırın sonundaki parantez karakterini silip, deneyin...

.
 
Katılım
10 Ocak 2011
Mesajlar
48
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
29/12/2022
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,892
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. :)
.
 
Katılım
10 Ocak 2011
Mesajlar
48
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
29/12/2022
.

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
 
Katılım
15 Ağustos 2024
Mesajlar
1
Excel Vers. ve Dili
2016 - eng.
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.
 
Üst