merhaba ekteki pdf den xmle farklı kayıt durumu veriyi excel şeklinde tablo nasıl alabilirim acaba;veriyi tek sutun halinde almam lazım yaklaşık olarak ekte yapılması istenen excel tablosu mevcut böyle bir şey mümkün mü
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Test()
'Haluk - 05/09/2023
'
Dim xDoc As Object
Dim strFile As String
Dim i As Integer, j As Integer
Set xDoc = CreateObject("MSXML2.DOMDocument")
xDoc.async = False
xDoc.validateOnParse = False
strFile = ThisWorkbook.Path & "\035267_4600963792_KDV1_36.xml"
i = 1
xDoc.Load strFile
Set objNodeList = xDoc.getElementsByTagName("indirilecekKDVOD")
For j = 0 To objNodeList.Length - 1
i = i + 1
Range("A" & i) = objNodeList(j).ChildNodes(0).BaseName
Range("B" & i) = objNodeList(j).ChildNodes(0).Text
i = i + 1
Range("A" & i) = objNodeList(j).ChildNodes(1).BaseName
Range("B" & i) = objNodeList(j).ChildNodes(1).Text
i = i + 1
Range("A" & i) = objNodeList(j).ChildNodes(2).BaseName
Range("B" & i) = objNodeList(j).ChildNodes(2).Text
Next
Set myNode = xDoc.SelectSingleNode("//indirilecekKDVODToplamKDV")
i = i + 1
Range("A" & i) = myNode.BaseName
Range("B" & i) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//tamIstisna/teslimVeHizmetTutari")
i = i + 1
Range("A" & i) = myNode.BaseName
Range("B" & i) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//tamIstisna/kdvOdemeksizinMalBedeli")
i = i + 1
Range("A" & i) = myNode.BaseName
Range("B" & i) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//tamIstisna/yuklenilenKDV")
i = i + 1
Range("A" & i) = myNode.BaseName
Range("B" & i) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//toplamTamTeslimVeHizmetTutari")
i = i + 1
Range("A" & i) = myNode.BaseName
Range("B" & i) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//toplamTamMalBedeliTutari")
i = i + 1
Range("A" & i) = myNode.BaseName
Range("B" & i) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//toplamTamYuklenilenKDV")
i = i + 1
Range("A" & i) = myNode.BaseName
Range("B" & i) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//toplamTamYuklenilenKDV")
i = i + 1
Range("A" & i) = myNode.BaseName
Range("B" & i) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//istisnaKapsamiTeslimVeHizmet")
i = i + 1
Range("A" & i) = myNode.BaseName
Range("B" & i) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//sonrakiDonemeDevredenKDV")
i = i + 1
Range("A" & i) = myNode.BaseName
Range("B" & i) = myNode.Text
Set xDoc = Nothing
End Sub
Sub Test()
'Haluk - 06/09/2023
'
Dim xDoc As Object
Dim strFile As String
Dim i As Integer, j As Integer
ChDir ThisWorkbook.Path
Cells.Clear
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 formatinda faturalarin olduðu klasörü seçmelisiniz....."
GoTo SafeExit:
End If
strFile = Dir(MyFolder.SelectedItems(1) & "\*.xml")
j = 0
Do While strFile <> ""
i = 1
j = j + 2
xDoc.Load SourceFolder.Path & "\" & strFile
Set myNode = xDoc.SelectSingleNode("//donem/yil")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
Columns(j).ColumnWidth = 30
Columns(j + 1).ColumnWidth = 10
Set myNode = xDoc.SelectSingleNode("//donem/ay")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
Set objNodeList = xDoc.getElementsByTagName("indirilecekKDVOD")
For k = 0 To objNodeList.Length - 1
i = i + 1
Cells(i, j) = objNodeList(k).ChildNodes(0).BaseName
Cells(i, j + 1) = objNodeList(k).ChildNodes(0).Text
i = i + 1
Cells(i, j) = objNodeList(k).ChildNodes(1).BaseName
Cells(i, j + 1) = objNodeList(k).ChildNodes(1).Text
i = i + 1
Cells(i, j) = objNodeList(k).ChildNodes(2).BaseName
Cells(i, j + 1) = objNodeList(k).ChildNodes(2).Text
Next
Set myNode = xDoc.SelectSingleNode("//indirilecekKDVODToplamKDV")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//tamIstisna/teslimVeHizmetTutari")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//tamIstisna/kdvOdemeksizinMalBedeli")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//tamIstisna/yuklenilenKDV")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//toplamTamTeslimVeHizmetTutari")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//toplamTamMalBedeliTutari")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//toplamTamYuklenilenKDV")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//toplamTamYuklenilenKDV")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//istisnaKapsamiTeslimVeHizmet")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
Set myNode = xDoc.SelectSingleNode("//sonrakiDonemeDevredenKDV")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
strFile = Dir
Loop
SafeExit:
Set xDoc = Nothing
End Sub
ü
hocam ekte 29 adet beyan var hepsi xml formatında , sadece versiyonları farklı bana vakit kaybettirmeden ;
dosya adı değiştirne elle tek tek veya bir başka şeye gerek kalmadan; direk çalıştıramadım; mümkün olduğunuzda bir bakar mısınız ;
birkaç deneme yaptım makro çalışırken dosya adı ve sırası gözetiyor; versiyon sanırım gözetiyor, dosya adı tariihi veriyonu gözetmeden kendi dönemler itibari ile yan yana dökebilirmi bu şekilde yapılablirmi;
ü
dosya adlarını sıralasam bile yine hata alıyorum yukarıdaki gibi;
teşekürler
Sub Test2()
'Haluk - 15/09/2023
'
Dim xDoc As Object
Dim strFile As String
Dim i As Integer, j As Integer
ChDir ThisWorkbook.Path
Cells.Clear
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 formatinda faturalarin olduðu klasörü seçmelisiniz....."
GoTo SafeExit:
End If
strFile = Dir(MyFolder.SelectedItems(1) & "\*.xml")
j = 0
Do While strFile <> ""
i = 1
j = j + 2
xDoc.Load SourceFolder.Path & "\" & strFile
Set myNode = xDoc.SelectSingleNode("//donem/yil")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
Columns(j).ColumnWidth = 30
Columns(j + 1).ColumnWidth = 10
Set myNode = xDoc.SelectSingleNode("//donem/ay")
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
Set objNodeList = xDoc.getElementsByTagName("indirilecekKDVOD")
For k = 0 To objNodeList.Length - 1
i = i + 1
Cells(i, j) = objNodeList(k).ChildNodes(0).BaseName
Cells(i, j + 1) = objNodeList(k).ChildNodes(0).Text
i = i + 1
Cells(i, j) = objNodeList(k).ChildNodes(1).BaseName
Cells(i, j + 1) = objNodeList(k).ChildNodes(1).Text
i = i + 1
Cells(i, j) = objNodeList(k).ChildNodes(2).BaseName
Cells(i, j + 1) = objNodeList(k).ChildNodes(2).Text
Next
Set myNode = xDoc.SelectSingleNode("//indirilecekKDVODToplamKDV")
If Not myNode Is Nothing Then
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
End If
Set myNode = xDoc.SelectSingleNode("//tamIstisna/teslimVeHizmetTutari")
If Not myNode Is Nothing Then
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
End If
Set myNode = xDoc.SelectSingleNode("//tamIstisna/kdvOdemeksizinMalBedeli")
If Not myNode Is Nothing Then
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
End If
Set myNode = xDoc.SelectSingleNode("//tamIstisna/yuklenilenKDV")
If Not myNode Is Nothing Then
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
End If
Set myNode = xDoc.SelectSingleNode("//toplamTamTeslimVeHizmetTutari")
If Not myNode Is Nothing Then
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
End If
Set myNode = xDoc.SelectSingleNode("//toplamTamMalBedeliTutari")
If Not myNode Is Nothing Then
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
End If
Set myNode = xDoc.SelectSingleNode("//toplamTamYuklenilenKDV")
If Not myNode Is Nothing Then
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
End If
Set myNode = xDoc.SelectSingleNode("//toplamTamYuklenilenKDV")
If Not myNode Is Nothing Then
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
End If
Set myNode = xDoc.SelectSingleNode("//istisnaKapsamiTeslimVeHizmet")
If Not myNode Is Nothing Then
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
End If
Set myNode = xDoc.SelectSingleNode("//sonrakiDonemeDevredenKDV")
If Not myNode Is Nothing Then
i = i + 1
Cells(i, j) = myNode.BaseName
Cells(i, j + 1) = myNode.Text
End If
strFile = Dir
Loop
SafeExit:
Set xDoc = Nothing
End Sub