Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Otwieranie kolejnych plików i zmiana rozszerzenia

Drwall · Świeżak Wersja: Win Office 365 Posty: 3

Witam,
potrzebowałbym makro, który otworzy wszystkie pliki, które znajdują się w danym folderze i zapisze je z rozszerzeniem xlsx, a następnie zamknie. Pliki najczęściej są w formacie .ods, niestety ich nazwy nie mają jakiegoś konkretnego schematu. Folder, w którym pojawiałaby się pliki do zamiany byłby cały czas ten sam.

Próbowałem takim makrem ale niestety nie działa i nie wiem co mógłbym poprawić:

Kod:

Sub test_loop()
'

'
'
Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\Users\...........\Desktop\Nowy folder"
MyFile = Dir(MyFolder & "*.ods")
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & MyFile

ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbook

ActiveWorkbook.Close
MyFile = Dir

Loop
End Sub

Maciej Gonet · Wysłany: 29-08-2022, 15:29

Między MyFolder a MyFile chyba brakuje \.

Tajan · **Pomógł:** 5234 razy Posty: 11414

Proponuję w taki sposób:

Kod:

Sub test_loop()
Dim FSO As Object
Dim MyFile As Object
Dim MyFolder As String
Dim MyODSname As String
Dim MyXLSname As String

MyFolder = "C:\Users\...........\Desktop\Nowy folder"

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each MyFile In FSO.GetFolder(MyFolder).Files
MyODSname = MyFile.Path
If LCase(FSO.GetExtensionName(MyODSname)) = "ods" Then
MyXLSname = MyFolder & "\" & FSO.GetBaseName(MyODSname) & ".xlsx"
If Dir(MyXLSname) = "" Then
With Workbooks.Open(MyODSname)
.SaveAs MyXLSname, FileFormat:=xlOpenXMLWorkbook
.Close
End With
End If
End If
Next

End Sub