XML Dosyasından istediğim veriyi çekme

[Haluk]

Sub Test()
    Dim xDoc As Object
    
    Cells.Clear

    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False
    xDoc.validateOnParse = False
    
    yol = ThisWorkbook.Path & "\"
    
    dosya = Dir(yol & "*" & ".xml", vbNormal)
    
    If dosya = "False" Then Exit Sub
    
    x = 1
    
    Do
        xDoc.Load yol & dosya
        
        Set Malzeme = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cac:Item/cbc:Name")
        Set Tanim = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cbc:ID")
        Set Fatura = xDoc.SelectNodes("//Invoice/cbc:ID")
        Set Miktar = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cbc:InvoicedQuantity")
        Set xName = xDoc.SelectSingleNode("//cac:AccountingSupplierParty/cac:Party/cac:PartyName/cbc:Name")

        
    
        For i = 0 To Malzeme.Length - 1
            Cells(x, 1) = Tanim.Item(i).nodetypedvalue
            Cells(x, 2) = Fatura.Item(0).nodetypedvalue
            Cells(x, 3) = xName.Text
            Cells(x, 4) = Malzeme.Item(i).nodetypedvalue
            Cells(x, 5) = Miktar(i).Attributes.getNamedItem("unitCode").Text
            Cells(x, 6) = Miktar.Item(i).nodetypedvalue
            x = x + 1
        Next
          
    dosya = Dir()
    
    Loop While dosya <> ""
 
    Cells.EntireColumn.AutoFit
    Set xDoc = Nothing
End Sub

.

 

[ERRİC]

Merhabalar ekteki dosyamda faturadaki gtip kodunun gelmesini sağlayabilirmiyiz; ilgili kodu nasıl düzeltebiliriz. yapmaya çalıştım ama gelmedi;
sadece ilgili kısmını yazdım kodun

xDoc.Load yol & dosya
        
        Set Malzeme = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cac:Item/cbc:Name")
        Set Tanim = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cbc:ID")
        Set Fatura = xDoc.SelectNodes("//Invoice/cbc:ID")
        Set Miktar = xDoc.SelectNodes("//Invoice/cac:InvoiceLine/cbc:InvoicedQuantity")
        Set xName = xDoc.SelectSingleNode("//cac:AccountingSupplierParty/cac:Party/cac:PartyName/cbc:Name")
        Set Gtip = xDoc.SelectNode("//Invoice/cac:GoodsItem/cbc:RequiredCustomsID")
        
    
        For i = 0 To Malzeme.Length - 1
            Cells(x, 1) = Tanim.Item(i).nodetypedvalue
            Cells(x, 2) = Fatura.Item(0).nodetypedvalue
            Cells(x, 3) = xName.Text
            Cells(x, 4) = Malzeme.Item(i).nodetypedvalue
            Cells(x, 5) = Miktar(i).Attributes.getNamedItem("unitCode").Text
            Cells(x, 6) = Miktar.Item(i).nodetypedvalue
            Cells(x, 7) = Gtip.Item(i).nodetypedvalue
            x = x + 1
        Next

 

[veyselemre]

Sub eFaturaXmlFaturaKalemleriniOku()
    Dim xDoc As Object, yol$, dosya$, x%, _
        xName As Object, fatura As Object, invoiceLine As Object, _
        malzeme As Object, tanim As Object, miktar As Object, gtip As Object

    Cells.Clear
    yol = ThisWorkbook.Path & "\"
    With CreateObject("MSXML2.DOMDocument")
        .async = False
        .validateOnParse = False

        dosya = Dir(yol & "*" & ".xml", vbNormal)
        If dosya = "False" Then Exit Sub
        x = 1

        Do
            .Load yol & dosya
            Set xName = .SelectSingleNode("//cac:AccountingSupplierParty/cac:Party/cac:PartyName/cbc:Name")
            Set fatura = .SelectNodes("//Invoice/cbc:ID").Item(0)
            For Each invoiceLine In .SelectNodes("//Invoice/cac:InvoiceLine")
                Set malzeme = invoiceLine.SelectNodes("cac:Item/cbc:Name").Item(0)
                Set tanim = invoiceLine.SelectNodes("cbc:ID").Item(0)
                Set miktar = invoiceLine.SelectNodes("cbc:InvoicedQuantity").Item(0)
                Set gtip = invoiceLine.SelectNodes("cac:Delivery/cac:Shipment/cac:GoodsItem/cbc:RequiredCustomsID").Item(0)
                Cells(x, 1).Value = tanim.nodetypedvalue
                Cells(x, 2).Value = fatura.nodetypedvalue
                Cells(x, 3).Value = xName.Text
                Cells(x, 4).Value = malzeme.nodetypedvalue
                Cells(x, 5).Value = miktar.Attributes.getNamedItem("unitCode").Text
                Cells(x, 6).Value = miktar.nodetypedvalue
                Cells(x, 7).NumberFormat = "@"
                Cells(x, 7).Value = gtip.nodetypedvalue
                x = x + 1
            Next invoiceLine
            dosya = Dir()
        Loop While dosya <> ""
    End With
    
    Cells.EntireColumn.AutoFit
End Sub

 

[ERRİC]

teşekkürler hocam elinize sağlık, iyi haftalar herkese

 

[ERRİC]

Sub eFaturaXmlFaturaKalemleriniOku()
    Dim xDoc As Object, yol$, dosya$, x%, _
        xName As Object, fatura As Object, invoiceLine As Object, _
        malzeme As Object, tanim As Object, miktar As Object, gtip As Object

    Cells.Clear
    yol = ThisWorkbook.Path & "\"
    With CreateObject("MSXML2.DOMDocument")
        .async = False
        .validateOnParse = False

        dosya = Dir(yol & "*" & ".xml", vbNormal)
        If dosya = "False" Then Exit Sub
        x = 1

        Do
            .Load yol & dosya
            Set xName = .SelectSingleNode("//cac:AccountingSupplierParty/cac:Party/cac:PartyName/cbc:Name")
            Set fatura = .SelectNodes("//Invoice/cbc:ID").Item(0)
            For Each invoiceLine In .SelectNodes("//Invoice/cac:InvoiceLine")
                Set malzeme = invoiceLine.SelectNodes("cac:Item/cbc:Name").Item(0)
                Set tanim = invoiceLine.SelectNodes("cbc:ID").Item(0)
                Set miktar = invoiceLine.SelectNodes("cbc:InvoicedQuantity").Item(0)
                Set gtip = invoiceLine.SelectNodes("cac:Delivery/cac:Shipment/cac:GoodsItem/cbc:RequiredCustomsID").Item(0)
                Cells(x, 1).Value = tanim.nodetypedvalue
                Cells(x, 2).Value = fatura.nodetypedvalue
                Cells(x, 3).Value = xName.Text
                Cells(x, 4).Value = malzeme.nodetypedvalue
                Cells(x, 5).Value = miktar.Attributes.getNamedItem("unitCode").Text
                Cells(x, 6).Value = miktar.nodetypedvalue
                Cells(x, 7).NumberFormat = "@"
                Cells(x, 7).Value = gtip.nodetypedvalue
                x = x + 1
            Next invoiceLine
            dosya = Dir()
        Loop While dosya <> ""
    End With
  
    Cells.EntireColumn.AutoFit
End Sub

Hocam merhaba bu ay dosyayı kullandığımda hata veriyor hiç gelmiyor ve faturanın ya 1 satırını ya da 50 kusur faturadan yarısnı döküp bırakıyor nedendir acaba bakma imkanınız var mıdır; örnek excel ve faturaları xml halinde ekledim

 

[Haluk]

Sub eFaturaXmlFaturaKalemleriniOku()
    Dim xDoc As Object, yol$, dosya, x%, _
        xName As Object, fatura As Object, invoiceLine As Object, _
        malzeme As Object, tanim As Object, miktar As Object, gtip As Object

    Cells.Clear
    yol = ThisWorkbook.Path & "\"
    With CreateObject("MSXML2.DOMDocument")
        .async = False
        .validateOnParse = False

        dosya = Dir(yol & "*" & ".xml", vbNormal)
        If dosya = False Then Exit Sub
        
        x = 1

        Do
            .Load yol & dosya
            Set xName = .SelectSingleNode("//cac:AccountingSupplierParty/cac:Party/cac:PartyName/cbc:Name")
            Set fatura = .SelectNodes("//Invoice/cbc:ID").Item(0)
            For Each invoiceLine In .SelectNodes("//Invoice/cac:InvoiceLine")
                Set malzeme = invoiceLine.SelectNodes("cac:Item/cbc:Name").Item(0)
                Set tanim = invoiceLine.SelectNodes("cbc:ID").Item(0)
                Set miktar = invoiceLine.SelectNodes("cbc:InvoicedQuantity").Item(0)
                Set gtip = invoiceLine.SelectNodes("cac:Delivery/cac:Shipment/cac:GoodsItem/cbc:RequiredCustomsID").Item(0)
                
                If Not tanim Is Nothing Then
                    Cells(x, 1).Value = tanim.nodetypedvalue
                End If
                
                If Not fatura Is Nothing Then
                    Cells(x, 2).Value = fatura.nodetypedvalue
                End If
                
                If Not xName Is Nothing Then
                    Cells(x, 3).Value = xName.Text
                End If
                
                If Not malzeme Is Nothing Then
                    Cells(x, 4).Value = malzeme.nodetypedvalue
                End If
                
                If Not miktar Is Nothing Then
                    Cells(x, 5).Value = miktar.Attributes.getNamedItem("unitCode").Text
                    Cells(x, 6).Value = miktar.nodetypedvalue
                    Cells(x, 7).NumberFormat = "@"
                End If
                
                If Not gtip Is Nothing Then
                    Cells(x, 7).Value = gtip.nodetypedvalue
                End If
                
                x = x + 1
            Next
            dosya = Dir()
        Loop While dosya <> ""
    End With
    
    Cells.EntireColumn.AutoFit
End Sub

.

 

[ERRİC]

teşekkürler hocam içini temizle yapıp tekrar çalıştırdığım da runtime 52 gibi bir hata oluyor ama nadir ; tekrar kapatıp açtığımda oluyor sürümden din belki .ok işimi görüyor, kullanım sonrası tekrar ihtiyac olursa destekleriniz rica edeceğim saygılar iyi haftalar