Форум программистов, компьютерный форум, киберфорум
Наши страницы
Visual Basic
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.80/5: Рейтинг темы: голосов - 5, средняя оценка - 4.80
Mat888
0 / 0 / 0
Регистрация: 10.07.2010
Сообщений: 1
1

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

14.07.2010, 08:09. Просмотров 857. Ответов 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
0
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
14.07.2010, 08:09
Ответы с готовыми решениями:

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

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

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

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

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

1
Toxa33rus
3882 / 881 / 122
Регистрация: 16.04.2009
Сообщений: 1,790
14.07.2010, 12:43 2
Как указать путь?
0
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
14.07.2010, 12:43

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

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

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


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

Или воспользуйтесь поиском по форуму:
2
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.