Sub FindEmptyFolders()
    Dim fso As Object, fld As Object
    Dim lr&, llastr&, s$, smainpath$, spath$
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    'если нужен путь к папке, в которой эти самые папки, а в АК только имя файла
    'smainpath = "C:\"
    'ищем последнюю заполненную ячейку в столбце AK
    llastr = Cells(Rows.Count, "AK").End(xlUp).Row
    'цикл по всем ячейкам столбца
    On Error Resume Next
    For lr = 2 To llastr
        s = Cells(lr, "AK").Value
        If s <> "" Then
            'если в столбец только имя файла
            'spath = smainpath & s
            spath = s
            'проверяем наличие папки
            Set fld = Nothing
            Set fld = fso.GetFolder(s)
            If Not fld Is Nothing Then
                'если в папке нет файлов
                If fld.Files.Count = 0 Then
                    Cells(lr, "AK").Interior.Color = vbRed
                End If
            End If
        End If
    Next
End Sub