1. Набираем команду codeby webinar. Набираем команду для организации и проведения вебинаров. Подробнее ...

    Скрыть объявление
  2. Требуются разработчики и тестеры для проекта codebyOS. Требования для участия в проекте: Знание принципов работы ОС на базе Linux; Знание Bash; Крайне желательное знание CPP, Python, Lua; Навыки системного администрирования. Подробнее ...

    Скрыть объявление
  3. Получи 30.000 рублей. Для получения денег необходимо принять участие в конкурсе авторов codeby. С условиями и призами можно ознакомиться на этой странице ...

    Внимание! Регистрация авторов на конкурс закрыта.

    Скрыть объявление

Макрос для Excel/access

Тема в разделе "Visual Basic", создана пользователем pockerhouse, 25 июн 2010.

Статус темы:
Закрыта.
  1. pockerhouse

    pockerhouse Гость

    Репутация:
    0
    Всем привет.
    С макросами я работаю недавно, но оч. хочу изучить поглубже.
    Многие вещи я просто не знаю, осуществимы ли или нет.
    Возникла потребность написать сложный макрос (для меня сложный), а я не понимаю даже можно ли это сделать.
    Суть в следующем:
    Есть какая-то папка на компе, в которой огромное кол-во подпапок.

    Надо, чтобы таблица Экселя или Аксесса автоматически прошерстила папку, выдала в первом столбце название файлов, а во втором ссылки на них. С чего начать - не представляю.

    Буду очень благодарен за любую помощь или идею.

    С уважением,
    pockerhouse
     
  2. Tanya

    Tanya Гость

    Репутация:
    0
    Можно использовать объект FileSystemObject из библиотеки scrrun.dll
    Ее можно подключить непосредственно в references или использовать функцию CreateObject,
    как в последующем примере.

    На листе Excel:
    | A | B
    1 | Folder: | d:\MyFolder
    2 |
    3 | FileName | Path
    4 | (Результаты)

    Модуль VBA.Лист1:
    Код:
    Private fso As Object
    Private r As Long
    
    Sub StartSearch()
    Dim fold As Object
    
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso Is Nothing Then
    r = 4
    
    Range(Cells(r, 1), Cells(UsedRange.Rows.Count, 2)).Clear
    
    Call SearchInFolder(Cells(1, 2).Value)
    
    End If
    
    End Sub
    
    Sub SearchInFolder(ByVal foldname As String)
    
    Dim fold As Object
    Dim f As Object
    
    
    If Len(foldname) > 0 Then
    If fso.FolderExists(foldname) Then
    Set fold = fso.GetFolder(foldname)
    
    For Each f In fold.Files
    'гиперссылка на файл, в ячейке будет отображаться только имя файла
    ActiveSheet.Hyperlinks.Add _
    Anchor:=Cells(r, 1), _
    Address:=f.Path, _
    SubAddress:=f.Name, _
    TextToDisplay:=f.Name
    
    Cells(r, 2).Value = f.Path & f.Name
    
    r = r + 1
    Next f
    
    For Each f In fold.SubFolders
    Call SearchInFolder(f.Path)
    
    Next f
    
    End If
    End If
    
    End Sub
    
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    If Target.Row = 1 And Target.Column = 1 Then Call StartSearch
    
    End Sub
    Запуск поиска осуществляется двойным кликом на ячейке A1 (возможны, конечно, иные варианты)
     
  3. pockerhouse

    pockerhouse Гость

    Репутация:
    0
    Спасибо, буду сидеть разбираться что к чему...
    Если есть ещё идеи, пишите, буду благодарен.
    Если можно, то ставте 'объяснения с апострофом, я же новичок :facepalm:
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей