Sub Test()
    Dim oFD As FileDialog, oFSO As Object, sFolderPath As String, Counter As Long
    Dim oFolder As Object, oFile As Object, tempWB As Workbook
    Dim NewFolderName As String, sFileNameWithoutExt As String
    
    If MsgBox("Пересохранить XLSB файлы в XLSX ?", vbQuestion + vbYesNo, "Вопрос") = vbNo Then Exit Sub
    
    NewFolderName = "Файлы XLSX" 'название папки, куда сохраним новые файлы
    
    Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
    With oFD
        .AllowMultiSelect = False
        .Title = "Укажите папку с файлами"
        .ButtonName = "Выбрать папку"
        If .Show = False Then Exit Sub Else sFolderPath = .SelectedItems(1) & Application.PathSeparator
    End With
    Set oFD = Nothing
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sFolderPath)
    If Not oFSO.folderexists(sFolderPath & NewFolderName) Then
        oFSO.CreateFolder (sFolderPath & NewFolderName)
    End If
    
    Application.ScreenUpdating = False
    For Each oFile In oFolder.Files
        If Not oFile.Name Like "*" & ThisWorkbook.Name & "*" Then
            If LCase(oFSO.GetExtensionName(oFile.Name)) = "xlsb" Then
                Counter = Counter + 1
                sFileNameWithoutExt = Mid(oFile.Name, 1, InStrRev(oFile.Name, ".") - 1)
                Set tempWB = Workbooks.Open(sFolderPath & oFile.Name, UpdateLinks:=False, ReadOnly:=True)
                tempWB.SaveAs sFolderPath & NewFolderName & Application.PathSeparator & sFileNameWithoutExt & ".xlsx", xlOpenXMLWorkbook '51
                tempWB.Close (False)
            End If
        End If
    Next oFile
    Application.ScreenUpdating = True
    MsgBox "Сохранено " & Counter & " файлов" & vbNewLine & "Файлы сохранены в " & sFolderPath & NewFolderName, vbInformation, "Конец"
End Sub