Excel VBA Error Handling with Permission Denied when accessing a folder / file

Question

I'm writing a script that looks at a certain file directory then makes a note of all folders in that location as well as the date it was last edited. It all works as expected however if it comes across a file that I don't have permissions for it errors (Run-time error '70': Permission denied).

I am no good at error handling and after trying a bunch of things I could think of and doing some research I am still stumped, what I would like is if there is a file it cannot access due to permissions it either just skips it or in a perfect world colours it red or something in the output then moves onto the next on the list.

Sub ListFoldersInDirectory()

'Application.ScreenUpdating = False

    Dim objFSO, objFolders, objFolder As Object
    Dim strDirectory, arrFolders(), test, a, LocationPath As String
    Dim FolderCount, FolderIndex, getdirorfilesize, oFO As Long
    Dim b, c As Integer

 On Error Resume Next
    If Err.number <> 0 Then
        If Err.number = 70 Then
            MsgBox "Permission Denied"
        'Else
            'MsgBox "An error occurred..."
        End If
        Err.Clear
    End If
    On Error GoTo 0
    
Sheets(2).Activate

'First time run to paste the first data in the correct place
Do While Sheets(2).Range("N1").Value = 0
Sheets(2).Range("N1").Value = 1

'Opens file directory and lets you select inital folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Select Folder"
        .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        End If
        strDirectory = .SelectedItems(1)
    End With
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolders = objFSO.GetFolder(strDirectory).Subfolders
    
    FolderCount = objFolders.Count
    
    'Checks what folders are in the specified folder then pastes them onto asheet
    If FolderCount > 0 Then
        ReDim arrFolders(1 To FolderCount)
        FolderIndex = 0
        For Each objFolder In objFolders
            FolderIndex = FolderIndex + 1
            arrFolders(FolderIndex) = objFolder.Name
        Next objFolder
        Sheets(1).Range("A1").Resize(FolderCount).Value = Application.Transpose(arrFolders)
        
        'Changes pasted data into a file address
        Sheets(1).Activate
        Sheets(1).Range("A1").Select
        Selection.End(xlDown).Select
        a = ActiveCell.Address
        Sheets(1).Range("A1:" & a).Select
            For Each x In Selection
            x.Activate
            ActiveCell.FormulaR1C1 = strDirectory & "\" & ActiveCell.Formula
            Next x
     
    'Moves Data to the main sheet
    Sheets(1).Activate
    Sheets(1).Range("A1").Select
    Selection.End(xlDown).Select
    b = ActiveCell.Row
            
    Range("A1:A" & b).Select
    Selection.Cut
    Sheets(2).Select
    Range("a1").Select
    'Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

'Retrieves time and date when file was last accessed
            Sheets(2).Activate
        Sheets(2).Range("A1").Select
        Selection.End(xlDown).Select
        a = ActiveCell.Address
        Sheets(2).Range("A2:" & a).Select
        For Each x In Selection
            x.Activate
            LocationPath = ActiveCell.Value
            ActiveCell.Offset(0, 1).FormulaR1C1 = _
        FileDateTime(LocationPath)
            Next x
    Else
        MsgBox "No folders found!", vbExclamation
    End If

Loop


    Set objFSO = Nothing
    Set objFolders = Nothing
    Set objFolder = Nothing
    
    'Application.ScreenUpdating = True

    'GetSubFolders

End Sub

As you can see at the top is an attempt at making something happen when it errors though with no luck, if it helps the portion that is highlighted on the debugger is 'FolderCount = objFolders.Count'

Apologies for the messy code, once it's all working I was planning on cleaning things up!