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.