Question

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

为了实现这一点，我尝试使用Office文件转换器，它告诉我没有任何文件可以转换。干杯微软。

我也尝试了几个宏建议。他们似乎都以：

结束

“Microsoft Excel已停止工作”

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

使用xlRepairData运行open似乎没有什么区别。

Set wbk = Workbooks.Open(Filename:=strPath & strFile, CorruptLoad:=xlRepairData)

xlExtractData运行良好，但也剥离了图像，而不是所需的行为！

Set wbk = Workbooks.Open(Filename:=strPath & strFile, CorruptLoad:=xlExtractData)

然后我创建了一批全新的.xls文件，其中包含一张兔子和小猫的图片，并将其复制到我有> 50个文件。运行此测试集重复打开和关闭就好了。的 AH-HAH！

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

“Microsoft Excel已停止工作”

我最近见过很多。

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

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

“运行时错误”-2147021892（80070bbc）'：Office已检测到a 这个文件的问题。为了帮助保护您的计算机，此文件不能被打开了。“

我在检测到错误时尝试跳过这些文件，这也会在灾难中结束 - 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

我不确定如何有效地使用this solution：

 Application.ProtectedViewWindows.Open Filename:=fName
 Application.ActiveProtectedViewWindow.Edit

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

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

提前感谢任何给予帮助的理智。：）

我的解决方法：

我安装了LibreOffice 5并从命令行运行它 {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"
    )
)

一旦脚本完成，有114个文件无法被LibreOffice转换，这些似乎没有问题通过Excel宏打开（我通过运行上面的Open-＆gt;关闭代码测试）。所以现在提出的解决方案和我一直试图适应的任何解决方案都应该有效。一旦确认就会更新。

Answer 1

行;所以以下内容可能适合您。如上所述，保存后文件将被删除。结果 - 如果它出错了，希望你只需要再次运行宏（或处理错误产生文件 - 这应该是文件夹中的第一个（* .xls）文件）

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

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

我的解决方法：

1 个答案: