Option Explicit

Dim Folder As String
Dim NazwaPliku As String
Dim PoczatekNazwy As String
Dim i As Long


Sub ZmianaFormatuXML()

Application.DisplayAlerts = False

For i = 1 To 5
    Folder = Cells(i + 2, 2)
    If Folder <> "" Then
            NazwaPliku = Dir(Folder & "*.xml")
            Do While NazwaPliku <> ""
            PoczatekNazwy = Left(NazwaPliku, Len(NazwaPliku) - 4)
            
                Workbooks.OpenXML Filename:=Folder & NazwaPliku, LoadOption:=xlXmlLoadImportToList
                
                    ActiveWorkbook.SaveAs Filename:=Folder & PoczatekNazwy & ".xlsx"
                ActiveWindow.Close
            
                Kill (Folder & NazwaPliku)
             NazwaPliku = Dir
            Loop
    End If
Next

Application.DisplayAlerts = True
MsgBox "Gotowe"

End Sub