2

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

为此，我尝试使用 Office 文件转换器，它告诉我没有任何文件可以转换。微软干杯。

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

“Microsoft Excel 已停止工作”

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

使用 xlRepairData 运行打开似乎没有什么不同。

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

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

Set wbk = Workbooks.Open(Filename:=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

我不确定如何有效地使用此解决方案： 

 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"
    )
)

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

4

1 回答 1

0

好的; 所以以下内容可能对您有用。如前所述，文件在保存后将被删除。结果 - 如果它确实出错，希望您只需要再次运行宏（或处理产生错误的文件 - 这应该是文件夹中的第一个 (*.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
于 2016-11-29T20:02:24.307 回答