Yardım Birden fazla XML dosyasını import etme

Malik · Dün 13:48 da

Değerli Forum Üyeleri,

Sizlere hayırlı günler diliyorum.

Birden fazla XML dosyasını aktif sayfaya import eden bir kod buldum. Kodu paylaşan arkadaşımın/büyüğümün affına sığınarak kodu buradan paylaşıyorum.

Kod:

Sub xlTR_192851_çok_sayıda_xml_dosyayı_aktif_sayfaya_import_etme()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next

Dim xmlKlasor As String, xmlDosyalar As String, xmlDosya As String
With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        If .Show = -1 Then xmlKlasor = .SelectedItems(1) & "\" Else Exit Sub 'klasör seçilmez ise uyarı vermeden makroyu sona erdirir
End With

xmlDosyalar = Dir(xmlKlasor & "*xml")
Do While xmlDosyalar <> ""
        xmlDosya = xmlKlasor & xmlDosyalar
        ActiveWorkbook.XmlImport Url:=xmlDosya, ImportMap:=Nothing, Overwrite:=True, Destination:=ActiveCell
       
       Selection.End(xlDown).Offset(1).Select 'xml dosyaları başlıkları ile, alt alta bitişik import eder
       ' Selection.End(xlDown).Offset(2).Select 'xml dosyaları başlıkları ile, alt alta arada 1 boş satır bırakarak import eder
        xmlDosyalar = Dir()
Loop
Cells.WrapText = False

End Sub

Kodu çalıştırdığımda ilk XML dosyası import edip, ikincisine başlarken "XML tablosu farklı bir XML eşlmesine bağlı olduğundan işlem tamamlanamıyor" hatası veriyor ve işlem sonlanıyor. Kodun başına "On Error Resume Next" yazıp çalıştırdığımda ise hedef klasördeki dosyaları bir atlayarak içeriye alıyor. Klasörde 100 dosya varsa bir atlayarak import ediyor. 50 adet XML dosyası import edilmiş oluyor.

Nerede yanlış yapıyor olabilirim? Ya da birden fazla XML dosyasını import edebileceğim farklı bir kod var mıdır? Konuyu baya bir araştırdım ama VBA-XML yeni öğrenmeye başladığım bir konu. Yardımlarınız için şimdiden teşekkür ederim.

eternalferit · Bugün 13:17

Orijinal kodunuzda ActiveWorkbook.XmlImport metodu kullanıyorsunuz ve ImportMap:=Nothing parametresiyle her seferinde yeni bir XML haritası (map) oluşturmaya çalışıyor. İlk dosya başarıyla import edildiğinde, Excel'de bir XML tablosu ve buna bağlı bir harita oluşuyor. İkinci dosyada ise Excel, mevcut tablonun farklı bir haritaya bağlı olduğunu düşünüyor (çünkü yeni bir harita oluşturmaya çalışıyor) ve hata veriyor: "XML tablosu farklı bir XML eşlemesine bağlı olduğundan işlem tamamlanamıyor."

On Error Resume Next ile hatayı atladığınızda, Excel import işlemini kısmen başarıyla tamamlıyor ama her seferinde bir dosya atlıyor, çünkü hata sonrası durum karışıyor (mevcut tabloyu güncelleyemiyor ve yeni bir tane oluşturamıyor).

aşağıdaki kod, XML haritalarını tamamen bypass ederek sorunu çözer:
Her XML dosyasını Workbooks.OpenXML ile geçici bir workbook olarak açar (bu, harita oluşturmadan veriyi liste olarak yükler).Veriyi (başlıklar dahil) kopyalar ve aktif sayfanın son satırının altına yapıştırır.Workbook'ı kapatır ve bir sonrakine geçer.Bu sayede 100 dosyanın tamamını başlıklarıyla alt alta bitişik import eder, hiçbirini atlamaz.Eğer XML dosyalarınızın yapısı aynıysa (aynı başlıklar ve sütunlar), sütunlar mükemmel hizalanır. Farklıysa, manuel düzeltme gerekebilir.

Bu yöntem VBA'da en basit ve güvenilir alternatif. Eğer sadece veri satırlarını (başlıksız) import etmek isterseniz, wb.Sheets(1).UsedRange.Copy yerine wb.Sheets(1).Range("A2").CurrentRegion.Copy kullanın (ilk satırı atlar).

Sub xlTR_192851_çok_sayıda_xml_dosyayı_aktif_sayfaya_import_etme() Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next

Dim xmlKlasor As String Dim xmlDosyalar As String Dim wb As Workbook Dim ws As Worksheet Dim sonSatir As Long

With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .InitialFileName = ThisWorkbook.Path If .Show = -1 Then xmlKlasor = .SelectedItems(1) & "" Else Exit Sub End With

Set ws = ActiveSheet ' Aktif sayfayı hedef olarak ayarla

xmlDosyalar = Dir(xmlKlasor & "*.xml") Do While xmlDosyalar <> "" ' XML dosyasını yeni bir workbook olarak aç (map sorunu olmadan) Set wb = Workbooks.OpenXML(Filename:=xmlKlasor & xmlDosyalar, LoadOption:=xlXmlLoadImportToList)

' Son veri satırını bul ve bir satır aşağıdan yapıştır (başlıklarla birlikte) sonSatir = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row If sonSatir = 1 Then sonSatir = 0 ' Eğer sayfa boşsa başa yapıştır wb.Sheets(1).UsedRange.Copy ws.Cells(sonSatir + 1, 1)

wb.Close False ' Değişiklik kaydetmeden kapat xmlDosyalar = Dir() Loop

ws.Cells.WrapText = False Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub

Yardım Birden fazla XML dosyasını import etme

Malik

eternalferit