在不打开工作簿的情况下使用VBA将.xls批量转换为.xlsx时的文件格式错误

时间:2019-02-25 06:12:54

标签: excel vba

我有数百个需要转换为XLSX的XLS文件。

我发现这个具有相同标题的旧线程,并且提供的代码将文件转换为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

1 个答案:

答案 0 :(得分: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