Importing files

[jordanburch]

Hi All,

I have the below code. Some of the files are locked for not editing and some have digital signatures, although it doesnt import one of the files without a digital signature nor any locked for editing so I may be wrong. Im wondering if that is the issue. When I run the import it only imports some of the files and not other. Im not sure why. Can anyone help?

Sub AllFiles()
Application.DisplayAlerts = False
    Application.ScreenUpdating = False
   
    Dim folderPath As String
    Dim Filename As String
    Dim wb As Workbook
    folderPath = "C:\Users\jordan.burch.ctr\Desktop\Cert Statements\" 'contains folder path
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
    Filename = Dir(folderPath & "*.xls*")
    Do While Filename <> ""
   
        Application.ScreenUpdating = False
'        On Error Resume Next
        Set wb = Workbooks.Open(folderPath & Filename, IgnoreReadOnlyRecommended:=True)
' Dim myPermission As Office.Permission
'    Set myPermission = ThisWorkbook.Permission
'    myPermission.Enabled = False
         Dim ws As Worksheet
    Dim ClearedSheet As String
    ClearedSheet = ""
    For Each ws In ActiveWorkbook.Worksheets
        If InStr(1, ws.Name, "Cleared", vbTextCompare) Then
            ClearedSheet = ws.Name
            Exit For
        End If
    Next
   If ClearedSheet <> "" Then
'   On Error Resume Next
'    ActiveWorkbook.Sheets(ClearedSheet).Range("Aw2:Aw" & Range("b" & Rows.Count).End(xlUp).Row).Value = Filename
        ActiveWorkbook.Worksheets(ClearedSheet).Range("a2:Aw" & Range("b" & Rows.Count).End(xlUp).Row).Copy
        Workbooks("Certification statement automation").Worksheets("Cleared").Range("b" & Range("b" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
    End If
        Workbooks(Filename).Close True
        Filename = Dir
       
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Jordan