DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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
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
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.
.
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
For Each FileItem In SourceFolder.Files
If FileItem.Type = "XML Document" Then
i = Range("A" & Rows.Count).End(xlUp).Row + 1
j = j + 1
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
For Each FileItem In SourceFolder.Files
If FileItem.Type = "XML Document" Then
i = Range("A" & Rows.Count).End(xlUp).Row + 1
j = j + 1
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