Здравствуйте! Нуждаюсь в вашей помощи с макросом. Есть следующий код (макрос и файл прилагаю), который находит все файлы в указанной папке и подпапках (файлы 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, Самое простое, попытаться открыть файл с пустым паролем, но есть подвох, если файл недоступен по иным причинам, то будет результат ,как и с установленным паролем., тут хоть и для 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
Никто не подскажет, как подстроить этот код под мой макрос, чтоб он выводил 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