Sub Test ()
Dim WB as Workbook, MPath as String, F as String
Application.DisplayAlerts = False
application.screenupdating = False
Application.calculation = xlcalculationmanual
If workbooks.count > 1 then MsgBox "Close the other workbooks and try again!" ": Exit Sub
MsgBox "Select the folder where the. xlsx file is located! "
With Application.filedialog (msoFileDialogFolderPicker)
. Show
. AllowMultiSelect = False
If. Selecteditems.count = 0 Then MsgBox "You gave up the operation!" ": Exit Sub
MPath =. SelectedItems (1)
End with
f = Dir (MPath & "\*.xlsx")
Do and F <> ""
If f <> Thisworkbook.name and left (F, Len (f)-1) <> Thisworkbook.name Then
Set wb = Workbooks.Open (MPath & "\" & F,, False)
Wb. SaveAs Filename:=mpath & "\" & Left (F, Len (f)-1), Fileformat:=xlexcel8
Wb. Close True
Kill MPath & "\" & F
End If
f = Dir
Loop
Application.DisplayAlerts = True
application.screenupdating = True
Application.calculation = xlcalculationautomatic
MsgBox "Processing done! "
End Sub
Convert xlsx to XLS with VB