- 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
