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

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

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

    pockerhouse Гость

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

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

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

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

    Tanya Гость

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

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

    Модуль VBA.Лист1:
    Код (LotusScript):
    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 Гость

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

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