Vba 用于将.xls转换为.xlsx的宏崩溃Excel

我的目标是将满是.xls文件的目录转换为.xlsx文件，同时保留嵌入的图像。需要一个自动化的解决方案，因为预期的文件集有几百个。我的测试集有532.xls文件。一次打开一个文件并保存它们确实有效，但显然很乏味，我更喜欢自动化

为了实现这一点，我尝试使用Office File Converter，它告诉我所有文件都无法转换。为微软干杯

我还尝试了一些宏观建议。它们似乎都以：

“Microsoft Excel已停止工作”

我还无法确定它崩溃的原因（在何处查找有用日志的帮助会很好，EventViewer似乎不包含任何对我有直接价值的内容）。起初我以为它正在打开文件，然后我读到它可能正在关闭文件。（似乎其他人也经历过这种情况）

使用xlRepairData运行open似乎没有什么不同

Set wbk=Workbooks.Open（文件名：=strPath&strFile，CorruptLoad:=xlRepairData）

xlExtractData运行得很好，但也去除了图像，而不是期望的行为

Set wbk=Workbooks.Open（文件名：=strPath&strFile，CorruptLoad:=xlExtractData）

然后，我创建了一批全新的.xls文件，其中包含一只兔子和小猫的图片，并将其复制到超过50个文件。运行此测试集可以重复地打开和关闭啊哈

我现在的印象是，正是我试图打开的文件导致了这个问题。我特别缩小了一个范围，我可以在“受保护视图”中手动打开，因为Excel认为它异常可疑。不幸的是，任何试图打开它的宏都会导致

“Microsoft Excel已停止工作”

我最近看到了很多

不幸的是，我无法共享特定文件，因为它包含不允许共享的数据，重新保存该文件以剥离私有数据可能会删除错误条件。（关于如何在新文件中重新创建条件的建议也很有用）

我已经尝试修改了两个建议的解决方案。Excel崩溃。偶尔也会显示此运行时错误：

“运行时错误“-2147021892（80070bbc）”：Office检测到 此文件有问题。为了帮助保护您的计算机，无法删除此文件 打开。”

我试图在检测到错误时跳过这些文件，这也会导致灾难性的Excel崩溃。是否有正确的方法中止导致错误的.Open操作

Sub ConvertToXlsx()
    Dim strPath As String
    Dim strFile As String
    Dim wbk As Workbook

    strPath = "C:\Test1\"
    strFile = Dir(strPath & "*.xls")
    On Error GoTo NextFile:
    Do While strFile <> ""
        If Right(strFile, 3) = "xls" Then
            Set wbk = Workbooks.Open(Filename:=strPath & strFile)
            'Save would go here
            wbk.Close SaveChanges:=False
            'Deleting the .xls file after would be a nice touch
        End If
NextFile:
        strFile = Dir
    Loop
End Sub

是否有好的代码块可以在目录中运行并打开任何.xls文件？它应该优雅地处理错误，而不是完全折叠Excel。也许它可以在尝试之前检查文件的兼容性。打开吗？ Excel是不是这项工作的错误工具

快速配置信息：
Windows 8.1 Pro-Excel 2013
Windows 10-Excel 2013

提前感谢您提供的任何理智帮助。：）

---

我的解决方法： 我安装了libreoffice5并从命令行运行它。

{install_dir}\program\soffice--headless--convert to xlsx:“Calc-MS-Excel 2007 XML”{filename}.xls

这要么起作用，创建xlsx文件，要么失败。。。默默地。 我使用下面的windows批处理脚本遍历xls文件的文件夹

@echo off

set soffice="C:\Program Files\LibreOffice 5\program\soffice"
for %%v in (*.xls) do (
    %soffice% --headless --convert-to xlsx:"Calc MS Excel 2007 XML" "%%v"
    if not exist "%%~nv.xlsx" (
        echo "ERROR: %%~nv"
    ) else (
        echo "***deleting %%v"
        del "%%v"
    )
)

---

脚本完成后，LibreOffice将无法转换214个文件，通过Excel宏打开这些文件似乎没有问题（我通过运行上面的Open->Close代码进行了测试）。因此，现在提出的解决方案和我一直试图适应的任何解决方案都应该可行。确认后将进行更新。

确定；因此，以下内容可能适用于您。如上所述，文件保存后将被删除。因此，如果出现错误，希望您只需再次运行宏（或处理产生错误的文件，该文件应为文件夹中的第一个（*.xls）文件）

子转换器xlstoxlsx（）
Dim sFolder作为字符串：sFolder=“P:\Test”
Dim wbOpen为工作簿，sFullName为字符串
关于GoTo ExitSub错误
Application.ScreenUpdating=False
对于枚举文件（sFolder）中的每个项目
sFullName=sFolder&“\\”项
Set wbOpen=get工作簿（sFullName）
Debug.Print wbOpen.Name
Application.DisplayAlerts=False
出错时继续下一步
wbOpen.SaveAs文件名：=sFullName&“x”，文件格式：=xlOpenXMLWorkbook
wbOpen，Close False
关于GoTo ExitSub错误
如果Len（Dir$（sFullName和“x”）>0，则Kill（sFullName）
Application.DisplayAlerts=True
下一项
进出口银行：
Application.ScreenUpdating=True
Application.DisplayAlerts=True
端接头
函数枚举文件（sFolder作为字符串）作为变量
Dim objFSO As Object:Set objFSO=CreateObject（“Scripting.FileSystemObject”）
Dim objFolder As Object:Set objFolder=objFSO.GetFolder（sFolder）
Dim objFile作为对象，V（）作为字符串
对于objFolder.Files中的每个objFile
如果正确（objFile.Name，4）=“.xls”，则
如果IsArrayAllocated（V）=False，则
雷迪姆V（0）
其他的
重播保留V（UBound（V）+1）
如果结束
V（UBound（V））=objFile.Name
如果结束
下一个objFile
枚举文件=V
端函数
函数IsArrayAllocated（Arr作为变量）作为布尔值
出错时继续下一步
IsArrayAllocated=IsArray（Arr）而不是iError（LBound（Arr，1））和LBound（Arr，1）我认为这与文件的处理方式无关，因为我在打开和关闭大量文件后有类似的Excel随机崩溃经验。当Excel应用程序崩溃时，我不得不编写单独的VB.Net程序来重新启动进程。您要转换的文件是
@echo off

set soffice="C:\Program Files\LibreOffice 5\program\soffice"
for %%v in (*.xls) do (
    %soffice% --headless --convert-to xlsx:"Calc MS Excel 2007 XML" "%%v"
    if not exist "%%~nv.xlsx" (
        echo "ERROR: %%~nv"
    ) else (
        echo "***deleting %%v"
        del "%%v"
    )
)

Sub ConvertXLStoXLSX()
    Dim sFolder As String: sFolder = "P:\Test"
    Dim wbOpen As Workbook, sFullName As String

    On Error GoTo ExitSub
    Application.ScreenUpdating = False
    For Each Item In EnumerateFiles(sFolder)
        sFullName = sFolder & "\\" & Item
        Set wbOpen = GetWorkBook(sFullName)
        Debug.Print wbOpen.Name
        Application.DisplayAlerts = False
            On Error Resume Next
                wbOpen.SaveAs FileName:=sFullName & "x", FileFormat:=xlOpenXMLWorkbook
                wbOpen.Close False
            On Error GoTo ExitSub
            If Len(Dir$(sFullName & "x")) > 0 Then Kill (sFullName)
        Application.DisplayAlerts = True
    Next Item

ExitSub:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Function EnumerateFiles(sFolder As String) As Variant
    Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objFolder As Object: Set objFolder = objFSO.GetFolder(sFolder)
    Dim objFile As Object, V() As String

    For Each objFile In objFolder.Files
        If Right(objFile.Name, 4) = ".xls" Then
            If IsArrayAllocated(V) = False Then
                ReDim V(0)
            Else
                ReDim Preserve V(UBound(V) + 1)
            End If
            V(UBound(V)) = objFile.Name
        End If
    Next objFile

    EnumerateFiles = V
End Function

Function IsArrayAllocated(Arr As Variant) As Boolean
    On Error Resume Next
    IsArrayAllocated = IsArray(Arr) And Not IsError(LBound(Arr, 1)) And LBound(Arr, 1) <= UBound(Arr, 1)
End Function

Public Function GetWorkBook(ByVal sFullName As String, Optional ReadOnly As Boolean) As Workbook
    Dim sFile As String: sFile = Dir(sFullName)
    On Error Resume Next
        Set GetWorkBook = Workbooks(sFile)
        If GetWorkBook Is Nothing Then Set GetWorkBook = Workbooks.Open(sFullName, ReadOnly:=ReadOnly)
        If GetWorkBook Is Nothing Then
            Dim wbPVW As ProtectedViewWindow
            Set wbPVW = Application.ProtectedViewWindows.Open(sFullName).Edit
            Set GetWorkBook = wbPVW.Workbook
        End If
    On Error GoTo 0
End Function