Question

我有9个子文件夹进行扫描和复制，将几张纸的内容粘贴到一张纸上，但是在最后一个文件上，当文件运行正常时，我出现错误1004“文件损坏”。但是，如果我告诉宏将其复制文件，这可能是一个线索问题，但我只丢失了几百行。

Private Sub extractionAl_Click()
    Dim Fso As Object
    Dim f1 As Object, f2 As Object
    Dim sh As Excel.Worksheet
    Dim SourceWB As Excel.Workbook
    Dim DestinationWB As Excel.Workbook
    Dim subf As Variant
    subf = "C:\Users\A60179\Desktop\Fichiers_extrait"
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set DestinationWB = Application.ThisWorkbook 'Workbooks("Test.xlsm")
    lstRow2 = 2
    For Each f1 In Fso.GetFolder(subf).subfolders
        For Each f2 In f1.Files
            If f2 Like "*Cahier*" Then
                Set SourceWB = Workbooks.Open(f2, ReadOnly:=True)
                For Each sh In SourceWB.Worksheets
                    If sh.Name = "Alarmes DOS" Then
                        lstRow1 = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
                        sh.Range("A2:K" & lstRow1).Copy
                        DestinationWB.Activate
                        alarmes.Range("A" & lstRow2).PasteSpecial 'xlPasteValues
                        Application.CutCopyMode = False
                        lstRow2 = alarmes.Cells(alarmes.Rows.Count, "A").End(xlUp).Row + 1
                    End If
                Next sh
                Workbooks(f2.Name).Saved = True
                Workbooks(f2.Name).Close
            End If
        Next f2
    Next f1
End Sub

Answer 1

当您遍历文件夹时，我相信您可能需要确保您没有真正在尝试读取临时/隐藏文件，我已对您的代码进行了修改以尝试排除此类文件：

Private Sub ExtractionAl_Click()
    Dim Fso As Object
    Dim f1 As Object, f2 As Object
    Dim sh As Excel.Worksheet
    Dim SourceWB As Excel.Workbook
    Dim DestinationWB As Excel.Workbook
    Dim subf As Variant
    subf = "C:\Users\A60179\Desktop\Fichiers_extrait"
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set DestinationWB = Application.ThisWorkbook 'Workbooks("Test.xlsm")
    lstRow2 = 2
    For Each f1 In Fso.GetFolder(subf).subfolders
        For Each f2 In f1.Files
            On Error Resume Next
            If f2 Like "*Cahier*" And Left(f2, 2) <> "~$" Then
                Set SourceWB = Workbooks.Open(f2, ReadOnly:=True)
                If Err.Number <> 0 Then MsgBox ("Unable to open file " & f2)
                For Each sh In SourceWB.Worksheets
                    If sh.Name = "Alarmes DOS" Then
                        lstRow1 = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
                        sh.Range("A2:K" & lstRow1).Copy
                        DestinationWB.Activate
                        alarmes.Range("A" & lstRow2).PasteSpecial 'xlPasteValues
                        Application.CutCopyMode = False
                        lstRow2 = alarmes.Cells(alarmes.Rows.Count, "A").End(xlUp).Row + 1
                    End If
                Next sh
                Workbooks(f2.Name).Saved = True
                Workbooks(f2.Name).Close
            End If
            On Error GoTo 0
        Next f2
    Next f1
End Sub

错误“ 1004”无法打开文件，因为其格式或扩展名无效

1 个答案: