Форум программистов, компьютерный форум, киберфорум
Visual Basic
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.88/8: Рейтинг темы: голосов - 8, средняя оценка - 4.88
Mat888

При нажатии на кнопку,должны выводиться только папки этой папки и их содержимое

14.07.2010, 08:09. Показов 1650. Ответов 1
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
При нажатии на кнопку,должны выводиться только папки этой папки и их содержимое.Не должны выводиться файлы с разными расширениями.только папки.
Еще когда выводиться папка,она должна быть вставлена в объедененные две (или три,я еще не знаю) горизонтальные ячейки.

Рисунки
1 новая папка\рисунки\1.jpg
2 новая папка\рисунки\2.jpg
3 новая папка\5.jpg
Видео
4 новая\новая папка\1.avi
5 новая папка\34.jpeg
Жесть
6 норм\просто жесть\4.txt


Папка объеденнена с двумя ячейками (или 2мя,можно в двух вариантах или скажите как сдеалать)
нумерация в одной ячейки,пути в другой

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Public Dst As Range
Public BasePath As String
Public FileNumber As Long
 
''''''''''''''''''''
' Функция выбора папки/пути
' Используемые аргументы:
' strTitle - текст, отображаемый над окном выбора папки
' lngRegim - режим отображения окна выбора
'            может комбинироваться путём сложения системных констант
'
'               Const BIF_STATUSTEXT = 4
'               Const BIF_RETURNONLYFSDIRS = 1
'               Const BIF_DONTGOBELOWDOMAIN = 2
'               Const BIF_BROWSEINCLUDEFILES = 16384
'               Const BIF_EDITBOX = 16
'               Const BIF_NEWDIALOGSTYLE = 64
'               Const BIF_NONEWFOLDERBUTTON = 512
'               и др.
'
' В случае нажатия на кнопку "Отмена" ("Cancel") функция возвращает "пустую" строку
'
''''''''''''''''''''
Function strGetAbsoluteFolderPathName(ByVal strTitle As String, ByVal lngRegim As Long) As String
    
    ' Определяем переменные
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFolderItem  As Object
    
    ' Создаём переменную Shell
    Set objShell = CreateObject("Shell.Application")
    
    ' Выводим диалоговое окно выбора папки с нужными параметрами
    Set objFolder = objShell.BrowseForFolder(0, strTitle, lngRegim)
    
    ' Если объект создан не удачно (НЕ выбрали какую-то папку), то
    ' возвращаем пустую строку в качестве результата работы функции...
    If objFolder Is Nothing Then
        strGetAbsoluteFolderPathName = ""
        Exit Function
    End If
    
    ' Получаем объект, у которого "можно спросить" его path
    Set objFolderItem = objFolder.Self
    ' Получаем значение Path
    strGetAbsoluteFolderPathName = objFolderItem.Path
    ' Удаляем все использованные объекты
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
End Function
 
Sub ListFiles(DPath, Ur)
Dim FName As String
Dim sd() As String, sdcount As Integer
Dim s As String
sdcount = 0
ReDim sd(0)
 
'и собственно список
    FName = Dir(DPath, vbDirectory)
    Do While FName <> ""
        If FName <> "." And FName <> ".." Then
                'ListFiles DPath & FName & "\"
                sdcount = sdcount + 1
                ReDim Preserve sd(sdcount)
                sd(sdcount) = DPath & FName
        End If
        FName = Dir
    Loop
 
    If (sdcount > 0) Then
        Dim i As Integer
        Dim attr
        For i = 1 To sdcount
            s = Mid(sd(i), Len(BasePath) + 2)
            attr = GetAttr(sd(i))
            If (((attr And vbDirectory) = 0) Or (Ur = 0)) Then
                If (Ur = 0) Then
                    Dst.Value = s
                    Dst.Font.Bold = True
                Else
                    Dst.Value = FileNumber
                    Dst.Offset(0, 1).Value = Mid(s, InStr(s, "\") + 1)
                    FileNumber = FileNumber + 1
                End If
                Set Dst = Dst.Offset(1)
            End If
            If (attr And vbDirectory) = vbDirectory Then
                ListFiles sd(i) & "\", Ur + 1
            End If
        Next
    End If
End Sub
Private Sub CommandButton1_Click()
Dim DPath As String
 
    DPath = strGetAbsoluteFolderPathName("Выберите папку", 4)
    If DPath = "" Then
        Exit Sub
    Else
        BasePath = DPath
        DPath = DPath & "\"
    End If
 
'On Error Resume Next
 
'запрашиваем ячейку
    Set Dst = Application.InputBox(prompt:="Выберите ячейку", Type:=8)
    If Not Dst Is Nothing Then Set Dst = Dst.Cells(1) Else Exit Sub
FileNumber = 1
ListFiles DPath, 0
End Sub
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
14.07.2010, 08:09
Ответы с готовыми решениями:

Удаление папки при нажатии на кнопку
Здравствуйте. На сайте нужно сделать возможность удаления с диска папки по нажатию на кнопку. Нашел в интернете готовое решение, но оно не...

Открытие указанной папки при нажатии на кнопку
Всем доброго времени суток! Можно ли сделать так, что бы в программе при нажатии кнопки открывалась какая-либо указанная папка Windows?

Изменение имени папки при нажатии на кнопку
Например есть определенная директория и в ней папка и при нажатии на кнопку в программе, название этой папки бы менялось. Может у кого есть...

1
 Аватар для Toxa33rus
3924 / 925 / 125
Регистрация: 16.04.2009
Сообщений: 1,975
14.07.2010, 12:43
Как указать путь?
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
14.07.2010, 12:43
Помогаю со студенческими работами здесь

Как в Delfi 7 при нажатии Batton открыть диалог выбора папки в подкаталоге программы и сохранить путь папки в Edit
Как в Delfi 7 при нажатии Batton открыть диалог выбора папки в подкаталоге программы и сохранить путь папки в Edit. С условием, что данная...

Вывод названия папки и пояснение к ней из файла txt внутри этой папки
Здравствуйте, дорогие друзья. Работаю над созданием одной программы и нужно сделать &quot;движок патчей&quot;. Поясняю, это сканирование...

После выбора папки в FolderBrowserDialog необходимо вывести путь до этой папки в текстовое поле
После выбора папки в FolderBrowserDialog необходимо вывести путь до этой папки в текстовое поле

Найти по имени папки расположение этой папки в сети
Всем доброго дня, нужна помощь разобраться с функциями поиска. Необходимо найти по имени папки расположение этой папки в сети. т.е. в...

Стереть содержимое папки, за исключением одной вложенной папки
В лаборатории стоят комьютеры. Посетители постоянно копируют на компьютеры в папку d:\shared\ всякий мусор, игры и т.п. Нужно написать...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
2
Ответ Создать тему
Новые блоги и статьи
Как я обхитрил таблицу Word
Alexander-7 21.03.2026
Когда мигает курсор у внешнего края таблицы, и нам надо перейти на новую строку, а при нажатии Enter создается новый ряд таблицы с ячейками, то мы вместо нервных нажатий Энтеров мы пишем любые буквы. . .
Krabik - рыболовный бот для WoW 3.3.5a
AmbA 21.03.2026
без регистрации и смс. Это не торговля, приложение не содержит рекламы. Выполняет свою непосредственную задачу - автоматизацию рыбалки в WoW - и ничего более. Однако если админы будут против -. . .
Программный отбор значений справочника
Maks 21.03.2026
Установка программного отбора значений справочника "Сотрудники" из модуля формы документа. В качестве фильтра для отбора служит предопределенное значение перечислений. Процедура. . .
Переходник USB-CAN-GPIO
Eddy_Em 20.03.2026
Достаточно давно на работе возникла необходимость в переходнике CAN-USB с гальваноразвязкой, оный и был разработан. Однако, все меня терзала совесть, что аж 48-ногий МК используется так тупо: просто. . .
Оттенки серого
Argus19 18.03.2026
Оттенки серого Нашёл в интернете 3 прекрасных модуля: Модуль класса открытия диалога открытия/ сохранения файла на Win32 API; Модуль класса быстрого перекодирования цветного изображения в оттенки. . .
SDL3 для Desktop (MinGW): Рисуем цветные прямоугольники с помощью рисовальщика SDL3 на Си и C++
8Observer8 17.03.2026
Содержание блога Финальные проекты на Си и на C++: finish-rectangles-sdl3-c. zip finish-rectangles-sdl3-cpp. zip
Символические и жёсткие ссылки в Linux.
algri14 15.03.2026
Существует два типа ссылок — символические и жёсткие. Ссылка в Linux — это запись в каталоге, которая может указывать либо на inode «файла-ИСТОЧНИКА», тогда это будет «жёсткая ссылка» (hard link),. . .
[Owen Logic] Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора
ФедосеевПавел 14.03.2026
Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ВВЕДЕНИЕ Выполняя задание на управление насосной группой заполнения резервуара,. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru