Преобразование всех файлов xml в каталоге в xls через vba

У меня в каталоге около 950 файлов .xml. Я могу без проблем открывать файлы .xml в Excel. Но я бы хотел конвертировать все файлы индивидуально в .xls (или .csv). Я поискал по форуму и нашел несколько ответов (см., Например, здесь и здесь), но пока не смог заставить его работать.

Наиболее близким к тому, что мне нужно, является следующий код:

Sub xmltoxl()
    Dim f As String
    Dim wbk As Workbook
    Dim s As Integer
    Dim tBook As Workbook
    Dim MySht As Worksheet

    Set tBook = ThisWorkbook
    Set MySht = tBook.Sheets(1)
    MySht.Cells.ClearContents

    f = Dir("C:\Users\Kanye\Downloads" & "\*.xml")
    s = 0

    Do While Len(f) > 0
        Set wbk = Workbooks.OpenXML("C:\Users\Kanye\Downloads" & "\" & f)
        If s = 0 Then
           wbk.Sheets(1).Cells.Copy Destination:=MySht.Cells
           LastRow = MySht.Range("A" & Rows.Count).End(xlUp).Row
           MySht.Range("Z1:Z" & LastRow) = f
        Else
           LastRow = MySht.Range("A" & Rows.Count).End(xlUp).Row
           NextRow = LastRow + 1

           wbkLastRow = wbk.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

           wbk.Sheets(1).Rows("1:" & wbkLastRow).Copy Destination:=MySht.Rows(NextRow)

           NewLastRow = MySht.Range("A" & Rows.Count).End(xlUp).Row
           MySht.Range("Z" & NextRow & ":Z" & NewLastRow) = f
        End If
        MySht.Columns("Z").Cut
        MySht.Columns("A").Insert

        s = s + 1
        wbk.SaveAs Filename:="C:\Users\Kanye\Downloads\Test" & s & ".csv"
        wbk.Close False
        f = Dir()
    Loop

End Sub 

Однако, когда я запускаю его, я получаю сообщение об ошибке после открытия первого .xml в каталоге. Есть идеи, как это решить?

2
0
513
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Я обнаружил, что наиболее эффективный метод Workbook.SaveAs - игнорировать любое расширение и позволить аргументу Формат файла выбрать его за вас.

...
wbk.SaveAs Filename:="C:\Users\Kanye\Downloads\Test" & s, fileformat:=xlcsv
wbk.Close savechanges:=False
...
Ответ принят как подходящий

Попробуйте этот код

Sub XMLTOCSV()
Dim f           As String
Dim p           As String
Dim s           As Integer

p = Environ("USERPROFILE") & "\Downloads" & "\"
f = Dir(p & "*.xml")
s = 0

Application.ScreenUpdating = False
    Do While Len(f) > 0
        s = s + 1
        ConvertXMLtoCSV p & f, p & "Test" & s & ".csv"
        f = Dir()
    Loop
Application.ScreenUpdating = True
End Sub

Sub ConvertXMLtoCSV(xmlFile, csvFile)
Dim xlApp       As Application
Dim xlBook      As Workbook

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.OpenXML(xmlFile, 2)
xlBook.SaveAs csvFile, 6
xlBook.Close False
xlApp.Quit
End Sub

Это действительно здорово работает! Спасибо! Есть ли способ назвать файлы .csv точно так же, как исходный .xml? Извините, что задаю такие вопросы нубов. Я никогда не работал с VBA.

Rachel 26.10.2018 12:27

Пожалуйста. Используйте эту строку вместо ConvertXMLtoCSV p & f, p & Replace(f, ".xml", "") & ".csv" ... И в этом случае вам не нужна переменная s

YasserKhalil 26.10.2018 14:03

Другие вопросы по теме