XML Dosyalarından Veri Alma

[selveroz]

Merhaba,

Elimde 50 küsür dosya var. Benim bu dosyaları tek tek açıp içindeki tek bir sütunun değerlerinin ortalamasını alıp tekrar kapatmam gerekli. Ortalamasının alınacağı makroyu yazdım. Ancak dosyaların tek tek açılıp macronun çalıştırılması da problem. Bu dosyaları bir makro yardımı ile açıp sonra ortalamasının alınıp dosyanın kapatılmasını sağlayabilir miyiz? Bu dosyaların yeri,

C:\Documents and Settings\user\My Documents\2008\04\XLS\01\1.xls
C:\Documents and Settings\user\My Documents\2008\04\XLS\01\2.xls... şeklinde.

Ayrıca her gün için ayrı bir klasör oluşturulacak. Örneğin ayın 2 si için,

C:\Documents and Settings\user\My Documents\2008\04\XLS\02\1.xls
C:\Documents and Settings\user\My Documents\2008\04\XLS\02\2.xls

gibi. Dolayısıyla makro aynı zamanda dosyaların path'inide çekmeli mi?Ya da çekebilir mi? Ya da nasıl bir kod yazmalıyım?

Lütfen fikirlerinizi benimle paylaşın.

Şimdiden çok teşekkürler.

 

[Levent Menteşoğlu]

Bu işlem için dosyayı açmaya gerek olmayabilir. Ortalama alınacak sütundaki veri aralığını verirmisiniz. Birde her dosyadan alınacak ortalamalar nereye kaydedilecektir. Yada kendi yazdığınız makroyuda verebilirsiniz.

 

[selveroz]

Merhaba arkadaşlar,

2 gündür bir program yazmaya çalışıyorum. Ama bir türlü istediğim şeyi beceremedim. Aklıma da sürekli farklı fikirler geliyor. Neyse şimdiki sorunum şu ki: elimde kayıtların tutulduğu bir .xml dosyaları var. Her dosya farklı bir müşteri için sistem tarafından tutuluyor. Dosya adları şöyle:

0000_1_bilgi
0000_2_bilgi
0414_1_bilgi
0414_2_bilgi .... vb.

şekilde devam ediyor. Bu arada yer alan baştaki 4 sayı (örneğin "0000") kayıdın tutulmaya başlandığı saat ve _ ler arasındaki sayı (örneğin 1) müşteri nosu. Ben bu xml dosyalarını, excele atmak istiyorum. Ancak her müşterinin tek bir dosyası olacak ve dosya bir günlük olacak. Yani o gün içerisinde alınmış olan tüm kayıtları birleştirmiş olacağız. Bu dosyaların tutulduğu yerin pathi ise;

C:\Documents and Settings\user\My Documents\2008\04\01

şeklinde. Yazmam gereken makro, öncelikle müşteri nosuna göre bir xls dosyası oluşturmalı ve o müşteriye ait tüm xml dosyalarını açıp kayıtları alt alta yapıştırmalı. Tüm kayıtlar bittikten sonra da dosyayı kapatmalı. Makronun dosyanın adını bilmesi imkansız olduğu, bir excel dosyası oluşturup dosya adlarını buraya girdim. Bu addan da bir path ismi oluşturdum. Yanına da bir command button yerleştirdim. Şimdi yapmam gereken, butona basıldığında makronun önce müşteri nosuna bakması ve öncelikle o noya ait bir excel dosyası oluşturması. Sonra tüm dosya adlarını tek tek kontrol edip o numaraya ait tüm kayıtları alt alta yapıştırması ve dosyayı kapatması. Yardımcı olmanızı istediğim durum ise yeni excel sayfasının nasıl oluşturulabilceği ve xml leri makro ile açıp içindeki tüm datayı seçip nasıl excele kopyalayabileceğim. Çok uzun oldu farkındayım ama yardımcı olursanız çok sevinirim. Şimdiden sonsuz tşkler.

 

[Zeki Gürsoy]

Merhaba,

Excelde hazır bir XML Import özelliği mevcut. Dosya listesini dosyada tutmak yerine "DIR" ile çekebilirsiniz.

Aşağıda, ihtiyacınıza göre geliştirebileceğiniz örnek Import modeli yer alıyor.

Sub XML_Import()
Dim lst As ListObject

ThisWorkbook.XmlImport _
    URL:="C:\Documents and Settings\user\My Documents\2008\04\01\0000_1_rates.xml", _
    ImportMap:=Nothing, Overwrite:=True, _
    Destination:=Range("$A$1")
    
[COLOR=DarkGreen]'> Liste özelliğini kaldırma...[/COLOR]
For Each lst In ActiveSheet.ListObjects
    lst.Unlist
Next

End Sub

 

[selveroz]

Teşekkür ederim.

Yardımlarınız için çok teşekkür ederim. Bu süper bir kodmuş. .xml dosyasını çekmekle kalmadı Dosyayı bir liste şekline getirdi. Gerçekten süper!!! Ancak bu işlemi yaparken halihazırda açık olan xls dosyası üzerine import etti. Yeni bir dosya açtırıp buraya import etmesini sağlayamaz mıyız? Yeni dosya açma kodu nedir? Ayrıca bir güne ait 5-6 .xml dosyasındaki dataları tek bir .xls dosyasında alt alta ekleyerek birleştirmem mümkün mü? O güne ait tüm değerleri tek bir .xls görmem gerek.

Bir de DIR ile tüm dosyaları nasıl çekebilirim?

Tekrar çok teşekkür ederim

 

[Zeki Gürsoy]

DIR Örneği:

const p = "C:\"

d = Dir(p & "*.xml")
while d <> ""
   debug.print p & d
   d=dir
wend

Her bir xml dosyası için debug.print satırı yerine yukarıda verdiğim prosedur çalışmalıdır.(Hedef hücre dinamik olacak tabiki)

Sayfaya düştükten sonra ortalaması kolaylıkla alınabilir.

 

[selveroz]

DIR Örneği:

const p = "C:\"

d = Dir(p & "*.xml")
while d <> ""
   debug.print p & d
   d=dir
wend

Her bir xml dosyası için debug.print satırı yerine yukarıda verdiğim prosedur çalışmalıdır.(Hedef hücre dinamik olacak tabiki)

Sayfaya düştükten sonra ortalaması kolaylıkla alınabilir.

Saolun Zeki Bey. Yardımlarınız için tekrar. Mesajımı düzelttim Rica etsem tekrar bakar mısınız?

 

[Zeki Gürsoy]

Yeni bir çalışma kitabı açılacak (kaydedilmemi&#351 ve ilgili dizindeki tüm xml dosyalarındaki veriler alt alta listelenecek.

NOT : İhtiyaç duyulabilecek konu olduğundan konu başlığı "XML Dosyalarından Veri Alma" olarak değişti.

Test edin...

Private yeni As Workbook
Private Const p = _
    "C:\Documents and Settings\user\My Documents\2008\04\01\"

Sub Hepsini_Al()
Dim x As Boolean

x = False
Set yeni = Workbooks.Add

d = Dir(p & "*.xml")
While d <> ""
   DoEvents
   
   son = yeni.Sheets(1).[a65536].End(3).Row
   
   If son > 1 Then
      son = son + 1
      x = True
    End If
    
   Call XML_Import(p & d, yeni.Sheets(1).Cells(son, "a"))
   
   If x Then yeni.Sheets(1).Rows(son).Delete
   
   d = Dir
Wend


End Sub

Sub XML_Import(Yol As String, Hedef As Object)
Dim lst As ListObject

yeni.XmlImport _
    URL:=Yol, ImportMap:=Nothing, Overwrite:=True, _
    Destination:=Hedef
    
'> Liste &#246;zelli&#287;ini kald&#305;rma...
For Each lst In yeni.Sheets(1).ListObjects
    lst.Unlist
Next

End Sub

 

[selveroz]

Zeki Bey çok saolun kodlar için.

Ancak ben sizin kodlarınızı kullanarak daha farklı bir makro yazdım. Her müşteri için ayrı bir çalışma kitabı oluşturmak istediğim için, .xml dosyalarındaki müiteri kodlarını kullanarak workbook oluşturuyorum. Daha sonra o kodu içeren tüm .xml dosyalarını sorguluyorum ve sizin alt programınızı kullanarak bu dosyalardan dataları import ediyorum. Ancak,

Dim B as Workbook
Set B = Workbooks("Busefer")
uzunluk = B.S1.Cells(65536, "D").End(xlUp).Row

yazdığım zaman excel şöle bir hata veriyor:

Object does not support this property or method.

Yani başa workbook adını eklememe izin vermiyor. Ancak iki workbook kullandığım için bunu kullanmalıyım. Bu hatayı nasıl çözebilirim?

Yardımcı olursanız çok sevinirim.

 

[selveroz]

Arkadaşlar lütfen yardımcı olur musunuz? Benim için önemli bir çalışma.

 

[selveroz]

Arkadaşlar kodu bir de DIR komutunu kullanarak yazmaya çalıştım. Lütfen bir bakar mısınız?

Private Sub CommandButton1_Click()

Dim B As Workbook
Dim S1, S2 As Worksheet
Dim filename
Dim uzunluk
Dim Sonsatir
Dim i, j As Integer
Dim x As Boolean
Dim dosya
Dim dizin

dizin = "c:\Documents and Settings\user\My Documents\2008\04\30\"

x = False

Set B = Workbooks("Busefer")
Set S1 = Sheets("Sheet1")
Set S2 = Sheets("Sheet2")

uzunluk = S1.Cells(65536, "D").End(xlUp).Row

For i = 1 To uzunluk

If Left(S1.Cells(i, "D").Value, 4) = "0000" Then

Workbooks.Add

filename = Mid(S1.Cells(i, "D").Value, 6, 1)

ActiveWorkbook.SaveAs filename:="C:\Documents and Settings\user\My Documents\2008\04\30\" & [filename]

dosya = Dir(dizin & "*"filename"*.xml*")

While dosya <> ""

DoEvents

Sonsatir = S1.Cells(65536, "A").End(xlUp).Row

If Sonsatir > 1 Then

Sonsatir = Sonsatir + 1

x = True

End If

Call XML_Import(dizin & dosya, filename.S1.Cells(Sonsatir, "A"))

If x = True Then

S1.Rows(Sonsatir).Delete

End If

dosya = Dir

Wend

End If

Next

End Sub

Sub XML_Import(Yol As String, Hedef As Object)
Dim lst As ListObject

filename.XmlImport _
URL:=Yol, ImportMap:=Nothing, Overwrite:=True, _
Destination:=Hedef

'> Liste özelliğini kaldırma...
For Each lst In filename.Sheets(1).ListObjects
lst.Unlist
Next

End Sub[/SIZE]