Ошибка формата файла при пакетном преобразовании .xls в .xlsx с VBA без открытия рабочих книг

Question

У меня есть сотни файлов XLS, которые мне нужно конвертировать в XLSX.

Я нашел этот старый поток с тем же названием, и предоставленный код преобразовывает файлы в XLSX, но портит их.

Насколько я понимаю, этот код переименовывает файл с соответствующим расширением xlsx, но делаетне изменять формат файла.

У меня сложилось впечатление, что мне нужно сделать файл формата FileFormat: = 51

Я попытался добавить ", FileFormat: = 51" к имени, но это сделалне похоже на работу.

Любые предложения о том, как я могу изменить FileFormat на 51?

Спасибо

Люблю вас всех

    Sub ChangeFileFormat_V1()

    Dim strCurrentFileExt   As String
    Dim strNewFileExt       As String
    Dim objFSO              As Object
    Dim objFolder           As Object
    Dim objFile             As File  'Object
    Dim xlFile              As Workbook
    Dim strNewName          As String
    Dim strFolderPath       As String

    strCurrentFileExt = ".xls"
    strNewFileExt = ".xlsx"

    strFolderPath = "C:\Users\Scorpio\Desktop\New folder"
    If Right(strFolderPath, 1) <> "\" Then
        strFolderPath = strFolderPath & "\"
    End If

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.getfolder(strFolderPath)
    For Each objFile In objFolder.Files
        strNewName = objFile.Name
        If Right(strNewName, Len(strCurrentFileExt)) = strCurrentFileExt Then
            strNewName = Replace(strNewName, strCurrentFileExt, strNewFileExt)
            Application.DisplayAlerts = False
            objFile.Name = strNewName
            Application.DisplayAlerts = True
        End If
    Next objFile

``ClearMemory:
    strCurrentFileExt = vbNullString
    strNewFileExt = vbNullString
    Set objFSO = Nothing
    Set objFolder = Nothing
    Set objFile = Nothing
    Set xlFile = Nothing
    strNewName = vbNullString
    strFolderPath = vbNullString
End Sub

Answer 1

Как я уже упоминал в комментарии, вы не можете просто изменить расширение и ожидать, что оно будет работать.Вы должны открыть файл и сделать .SaveAs NewFilename,Fileformat для каждого из них.

Это то, что вы пытаетесь?( Не проверено )

 Sub Sample()
    Dim strFolderPath As String
    Dim StrFile As String
    Dim NewFilename As String
    Dim wb As Workbook

    '~~> Set your folder here
    strFolderPath = "C:\Users\Scorpio\Desktop\New folder\"

    '~~> Loop through all the xls files in the folder
    StrFile = Dir(strFolderPath & "*.xls")

    Do While Len(StrFile) > 0
        '~~> Get file name without extension
        NewFilename = Left(StrFile, (InStrRev(StrFile, ".", -1, vbTextCompare) - 1))

        Set wb = Workbooks.Open(strFolderPath & StrFile)

        wb.SaveAs NewFilename & ".xlsx", FileFormat:=xlOpenXMLWorkbook
        DoEvents
        wb.Close (False)
        StrFile = Dir
    Loop
End Sub