CODEWITHSUNDEEP
vbaexcel
Ibrahim
Ibrahim

Reputation: 79

error "1004" impossible to open the file because its format or extension is not valid

I have 9 subfolders to scan and copy paste the contents of several sheets on a single sheet but on the last file I have an error 1004 "file corrupt" when the file works perfectly.however if I tell the macro to copy this file it may be a clue problem but I only have a few hundred lines I'm lost.

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

Upvotes: 0

Views: 158

Answers (1)

Xabier
Xabier

Reputation: 7735

As you loop through the folder, I believe you might need to make sure you aren't actually trying to read temporary/hidden files, I've adapted your code to attempt to exclude such files:

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

Upvotes: 1

Related Questions