XML dosyalardaki içeriklerin birleştirilmesi

[sakoz]

Birden fazla kapalı olan XML dosyadaki verilerin birleştirilmesi - PROBLEM ÇÖZÜLDÜ.

Sevgili Üstadlar Merhaba ,

Bir konuda yardımınıza ihtiyacım var....
Şimdi ; bana sürekli xml formatında gelen dosyalar var.Bunlar adresleme dosyaları...Adresleme dosyalarının sonu ise YER veya HAS olarak bitiyor...
Örnek ; 20080820151552YER veya 20080820163349HAS gibi...

Buna göre , dosyaları excelde açtıktan sonra E sütununda şasi ve G sütunundaki adres bilgilerini kopyalayıp , yeni bir excel çalışma sayfası açıp buraya yapiştırıyorum...Bana gelen tüm dosyaları açıp aynı şekilde kopyala yapıştır yapıp yeni excel sayfasına ekliyorum...Yani kısacası tüm şasiler ve adreslelerini bir sayfada topluyorum...
Tabi dosya sayısı çok olduğu için , epey bir zamanımı alıyor...Bunun için yapabileceğimiz birşey varmıdır acaba...
Mesela ; Tüm YER ve HAS dosyalarındaki bilgileri alıp tek sayfaya toplayabilecek bir işlem yapılabilirmi ?
İlgilenen herkese şimdiden teşekkür ederim...

İyi çalışmalar...

Not : dosyalar xml formatındadır..Fakat foruma upload ederken hata verdiği icin xls yapılmıştır...Bilginize.

 

[sakoz]

Arkadaşlar,

Yardımcı olabilecek kimse yokmu acaba ?

 

[sakoz]

Üstadlar konuyla ilgili yardımcı olabilecek herkese şimdiden teşekkürler...

 

[sakoz]

Problem ÇÖzÜldÜ...!

Sorunumuz Sayın KORHAN AYHAN üstadımız tarafından çözüme kavuşturulmuştur.Kendisine ayrıca teşekkür ederim...İhtiyacı olan arkadaşlar olacağını düşündüğüm icin cevabı aktarıyorum...

Masaüstünde bir klasör oluşturun ve adını VERİLER olarak düzenleyin. İçinden bilgileri alacağınız dosyaları bu klasöre aktarın. Daha sonra ekteki örnek dosyayı açın ve makroyu çalıştırın.

Not: Koddaki kırmızı renkle belirtilmiş dosya yolunu kendi sisteminize göre düzeltmeyi unutmayın.


Kod:
Sub VERİLERİ_GÜNCELLE()
Application.ScreenUpdating = False
Dosya_Yolu = "C:\Documents and Settings\Admin\Desktop\VERİLER\"
Set S1 = Workbooks("ANA DOSYA.xls").Sheets("Sayfa1")
S1.Select
[A2:B65536].ClearContents
Set Klasör = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
For Each Dosya In Klasör
If InStr(Dosya.Name, ".xls") > 0 Then
If Dosya.Name <> "ANA DOSYA.xls" Then
Workbooks.Open Filename:=Dosya
Sheets("Sayfa1").Select
Range("E2:E" & [E65536].End(3).Row).Copy S1.Cells(65536, 1).End(3).Offset(1)
Range("G2:G" & [G65536].End(3).Row).Copy S1.Cells(65536, 2).End(3).Offset(1)
ActiveWorkbook.Close True
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub