Страницы: 1
RSS
Подтянуть значение, показывающее установлен на файлах пароль?, изменить макрос
 
Здравствуйте! Нуждаюсь в вашей помощи с макросом. Есть следующий код (макрос и файл прилагаю), который находит все файлы в указанной папке и подпапках (файлы xls, xlsx, docx, txt, PDF с текстом), и выводит название файла, адрес и т.п. на новый лист. Как изменить код, чтобы в столбец С с помощью макроса вывести "yes" - если файл защищен паролем (файлы разных расширений - см. выше), "no" - если пароля нет.
Прошу о помощи и заранее спасибо, жду ваших ответов

Код
Sub Макрос5()
    Dim V As String
    Dim BrowseFolder As String
     
    'открываем диалоговое окно выбора папки
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите папку или диск"
        .Show
        On Error Resume Next
        Err.Clear
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            MsgBox "Вы ничего не выбрали!"
            Exit Sub
        End If
    End With
    BrowseFolder = CStr(V)
     
    'добавляем лист и выводим на него шапку таблицы
    ActiveWorkbook.Sheets.Add
    With Range("A1:E1")
        .Font.Bold = True
        .Font.Size = 12
    End With
    Range("A1").Value = "Имя файла"
    Range("B1").Value = "Путь"
    
    'вызываем процедуру вывода списка файлов
    'измените True на False, если не нужно выводить файлы из вложенных папок
    ListFilesInFolder BrowseFolder, True
End Sub
 
 
Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
 
    Dim FSO As Object
    Dim SourceFolder As Object
    Dim SubFolder As Object
    Dim FileItem As Object
    Dim r As Long
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.getfolder(SourceFolderName)
 
    r = Range("A65536").End(xlUp).Row + 1   'находим первую пустую строку
    'выводим данные по файлу
    For Each FileItem In SourceFolder.Files
        Cells(r, 1).Formula = FileItem.Name
        Cells(r, 2).Formula = FileItem.Path
        r = r + 1
        X = SourceFolder.Path
    Next FileItem
     
    'вызываем процедуру повторно для каждой вложенной папки
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
 
    Columns("A:E").AutoFit
 
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
 
End Sub
Изменено: Art89 - 18.02.2018 18:04:10 (Скорректировал тему - убрал лишние вопросы)
 
Art89, Самое простое, попытаться открыть файл с пустым паролем, но есть подвох, если файл недоступен по иным причинам, то будет результат ,как и с установленным паролем., тут хоть и для PPTX но подойдет и для XLSX, другой метод, Мне было важно отделить отсутсвие доступа и установленный пароль. Если это не важно, то проверка на наличие файла, попытка его открыть. Есть файл и не открылся, то он запаролен.

Остальные вопросы требуют других тем. + оформите код корректно, Выделить код и <...> в панели сообщения.
По вопросам из тем форума, личку не читаю.
 
БМВ, спасибо за ссылки и рекомендации - тему отредактировал. Мне подходит самое простое решение (код ниже), подскажите пожалуйста, как его интегрировать в мой макрос, чтобы он выводил yes or no в столбце C напротив нужного файла (Message Boxes не нужны).
Код
Sub test()
    On Error Resume Next
    filename$ = "C:\Users\Игорь\Desktop\файл с паролем.xls"
    'filename$ = "C:\Users\Игорь\Desktop\файл без пароля.xls"
 
    Dim WB As Workbook
    Set WB = Workbooks.Open(filename$, , , , "")        ' задаём пустой пароль в параметрах Workbooks.Open
 
    If WB Is Nothing Then
        MsgBox "Файл не открыт - т.к. запаролен"
    Else
        MsgBox "Открыт файл " & WB.Name
    End If
End Sub
Изменено: Art89 - 18.02.2018 18:12:20
 
Никто не подскажет, как подстроить этот код под мой макрос, чтоб он выводил yes or no в столбце C напротив нужного файла в зависимости стоит на файле пароль или нет? В моем случае это не только файлы .xml и .xmls, но и .pdf, docx, txt. Я изменил значения then на Cells(r, 3).Formula = "yes"; else на Cells(r, 3).Formula = "no"; Set WB = Workbooks.Open(FILEITEM, , , , ""). В итоге выдает yes напротив каждого файла. Помогите разобраться, заранее спасибо за любые советы.
Код
Sub test()
    On Error Resume Next
  
    Dim WB As Workbook
    Set WB = Workbooks.Open(filename$, , , , "")        ' задаём пустой пароль в параметрах Workbooks.Open
  
    If WB Is Nothing Then
        Cells(r, 3).Formula = "yes"
    Else
        Cells(r, 3).Formula = "no"
    End If
End Sub
Страницы: 1
Наверх