, и вам спасибо.
, спасибо за предположения, обращусь к нашим администраторам.
, спасибо за предположения, обращусь к нашим администраторам.
|
05.06.2023 11:55:33
Добрый день. Прошу помочь добавить в сам макрос путь конкретной папки, что бы каждый раз не выбирать одну и туже папку через диалоговое окно.
Путь к папке предположим: \\sbc01\shares\Marketing\Trade Marketing\Фоотчеты LSM\2023\433. Документ с примером прилагаю. Макрос: Sub FileList() 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) Intersect(Rows("1:" & Rows.Count), ActiveSheet.UsedRange).ClearContents With Range("A1:С1") .Font.Bold = True .Font.Size = 12 End With Range("A2").Value = "Имя файла" Range("B2").Value = "Путь" Range("c2").Value = "Дата изменения" 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 = "=HYPERLINK(""" & FileItem.Path & """)" Cells(r, 3).Formula = FileItem.DateLastModified 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 Columns("A:A").ColumnWidth = 20 Columns("A:A").ColumnWidth = 35 Columns("A:A").ColumnWidth = 15 End Sub Private Sub Workbook_Open() End Sub |
|
|
|
|
|
13.03.2023 11:16:01
Добрый день. Есть популярный макрос на поиск самого нового документа в папке.
Подскажите пожалуйста, как вывести второй по новизне файл (так сказать 2 самых новых файла)? Sub ПримерИспользованияФункции_LastFile() ' Ищем на рабочем столе все файлы TXT, и выводим имя самого нового файла. ' Просматриваются папки с глубиной вложения не более трёх. Dim ПутьКПапке$, СамыйПоследнийФайл$ ' получаем путь к папке РАБОЧИЙ СТОЛ ПутьКПапке = CreateObject("WScript.Shell").SpecialFolders("Desktop") ' получаем путь к самому новому файлу (проверяется дата последнего сохранения) СамыйПоследнийФайл$ = LastFile$(ПутьКПапке, ".txt", 3) If СамыйПоследнийФайл$ = "" Then MsgBox "Не найдено ни одного файла", vbExclamation: Exit Sub MsgBox СамыйПоследнийФайл$, vbInformation, "Самый свежий файл" End Sub Код функции: Function LastFile$(ByVal FolderPath As String, Optional ByVal Mask As String = "", _ Optional ByVal SearchDeep As Long = 999) ' Получает в качестве параметра путь к папке FolderPath, ' маску имени искомых файлов Mask (будут проверены только файлы с такой маской/расширением) ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются). ' Возвращает полный путь к файлу, имеющему самую позднюю дату создания ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO) Dim FilenamesCollection As New Collection ' создаём пустую коллекцию Set FSO = CreateObject("Scripting.FileSystemObject") ' создаём экземпляр FileSystemObject GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск Set FSO = Nothing: Application.StatusBar = False ' очистка строки состояния Excel Dim maxFileDate As Double For Each file In FilenamesCollection ' перебираем все файлы среди найденных currFileDate = FileDateTime(file) ' считываем дату последнего сохранения ' проверяем очередной файл - не новее ли он предыдущих If currFileDate > maxFileDate Then LastFile$ = file: maxFileDate = currFileDate Next file End Function Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _ ByRef FileNamesColl As Collection, ByVal SearchDeep As Long) ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO ' перебор папок осуществляется в том случае, если SearchDeep > 1 ' добавляет пути найденных файлов в коллекцию FileNamesColl On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath) If Not curfold Is Nothing Then ' если удалось получить доступ к папке Application.StatusBar = "Поиск в папке: " & FolderPath For Each fil In curfold.Files ' перебираем все файлы в папке FolderPath If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path Next SearchDeep = SearchDeep - 1 ' уменьшаем глубину поиска в подпапках If SearchDeep Then ' если надо искать глубже For Each sfol In curfold.SubFolders ' ' перебираем все подпапки в папке FolderPath GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep Next End If Set fil = Nothing: Set curfold = Nothing ' очищаем переменные End If End Function
Изменено: - 13.03.2023 11:17:47
|
|
|
|
|
|
10.03.2023 16:37:11
Добрый день. Есть популярный макрос, который находит последний документ (самый новый по дате создания) в папке:
Как можно скорректировать для поиска предпоследнего документа в папке? я вижу, что в самой функции lastfile$, есть PreFile$, и в Locals я его тоже вижу, но как этот адрес сохранить для переменной какой-то? |
|
|
|
|
|
27.10.2022 15:47:21
Добрый день.
Есть документ ИТОГО и документ СПРАВОЧНИК. Если у сотрудника есть доступ к документу СПРАВОЧНИК, то формулы считают в документе ИТОГО и результат расчетов показывает. Если нет доступа к документу СПРАВОЧНИК, тогда в документе ИТОГО ссылка. Можно ли сделать так, что бы формулы считались, даже если доступа к папке у сотрудника нет, где лежит документ СПРАВОЧНИК? |
|
|
|
|
|
26.10.2022 12:28:50
|
|||||
|
|
|