Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Microsoft Office и VBA > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 04.01.2012, 19:13   #1
@лeся
Пользователь
 
Аватар для @лeся
 
Регистрация: 04.01.2012
Сообщений: 44
Репутация: 18
По умолчанию Как скопировать имена выбранных файлов в Listbox?

Здравствуйте.
Может я плохо ориентируюсь в справках,но не могу найти как вытащить именно имена файлов и собрать их в Listbox
т.е. задача такая у меня маленькая формочка(диалоговое окно), при нажатии кнопки идет запрос FilePicker через ctrl выбираю несколько файлов,но я пока нашла что бы показывало filepath

далее после listboxa надо всю эту текстовку в таблицу документа вставить причем в разные строки,ну впрочем это наверное мелочь,это я сама разберусь.
подскажите пожалуйста,как быть далее?
-----------------------------------------------------------------

Код:
Private Sub CommandButton2_Click()
    Dim fd As FileDialog
    Dim vrtSelectedItem As Variant


    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        'Добавляется фильтр по типам файлов JPG и DOC.
        .Filters.Add "Images", "*.xls; *.xlsx; *.jpg; *.jpeg; *.doc; *.docx", 1
        
        'Выбор несокльких файлов через Ctrl
        .AllowMultiSelect = True

        'По умолчанию для выбора предоставляется определенный диск
        .InitialFileName = "D:\"

        If .Show = -1 Then
                 For Each vrtSelectedItem In .SelectedItems
        ' Для проверки месадж отображает путь файла
                MsgBox "Selected item's path: " & vrtSelectedItem
            Next vrtSelectedItem
        Else
        End If
    End With

    'дальше пока ничего...
    Set fd = Nothing

End Sub
Tahoma
Изображения
 
@лeся вне форума   Ответить с цитированием
Старый 04.01.2012, 19:43   #2
@лeся
Пользователь
 
Аватар для @лeся
 
Регистрация: 04.01.2012
Сообщений: 44
Репутация: 18
По умолчанию

кхм, кажись я начала понимать, пробую команду Split по "\" , надо теперь сделат что бы оставалось только последнее значение строки.

п.с. но от помощи не откажусь
@лeся вне форума   Ответить с цитированием
Старый 04.01.2012, 20:49   #3
Ципихович Эндрю
Профессионал
 
Регистрация: 24.01.2011
Сообщений: 2,305
Репутация: 52
По умолчанию

делайте под себя
Код:
'предварительно нужно добавить ссылку на Microsoft Excel 12.0 Object Library
Dim ExApp As New Excel.Application
Dim vFileName As Variant
Dim fso As Object, f As Object, FilesToRename
Dim k%
Dim Полный_путь_к_файлу As String
Dim Имя_файла_с_расширением As String
Dim Имя_файла_без_расширения As String
Dim Расширение_файла As String

'выбор файлов для переименования
FilesToRename = ExApp.GetOpenFilename(, , "Выбери себе файл", , True)

'условие, если выбран хотя бы один файл
If IsArray(FilesToRename) Then

    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'для каждого выбранного файла
    For k = 1 To UBound(FilesToRename)
        Set f = fso.GetFile(FilesToRename(k))
        'путь к файлу, имя файла с расширением
        Полный_путь_к_файлу = f.Path
        Debug.Print Полный_путь_к_файлу
        Имя_файла_с_расширением = f.Name
        Имя_файла_без_расширения = CreateObject("Scripting.FileSystemObject").GetBaseName(f.Name)
        Расширение_файла = CreateObject("Scripting.FileSystemObject").GetExtensionName(f)
        'переименование файла
        'чтобы не было ошибки
        '58  File already exists Файл уже существует
        'нужно переименовывать файл
        f.Name = "0000000000" & f.Name
        'перемещаем файл
        'если имя файла менять не надо, тогда можно указать только папку - f.Move "L:\Изменённые\"
        f.Move "L:\Изменённые\" & f.Name
        Set f = Nothing
    Next k
    Set fso = Nothing
    Erase FilesToRename
End If
'завершаем Excel
ExApp.Quit

'вывести список файлов находящихся в определённой папке
    MyPath = "D:\Документы"
    MyName = Dir(MyPath, vbDirectory)
    Do While MyName <> ""
        If MyName <> "." And MyName <> ".." Then
            'маска файлов с нужным расширением
            If MyName Like "*.txt" Then 
                'вывод названий файлов в TextBox
                TextBox1.Text = TextBox1.Text & MyName & vbCrLf
            End If
        End If
        MyName = Dir
    Loop
Ципихович Эндрю на форуме   Ответить с цитированием
Старый 04.01.2012, 20:49   #4
Казанский
Профессионал
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
Репутация: 938
По умолчанию

Можно использовать Split:
Код:
dim x
'...
x=split(.vrtSelectedItem,"\")
MsgBox "Selected item's FileName: " & x(ubound(x))
Но мне больше нравится так:
Код:
MsgBox "Selected item's FileName: " & mid$(.vrtSelectedItem,instrrev(.vrtSelectedItem,"\")+1)
Казанский вне форума   Ответить с цитированием
Старый 05.01.2012, 12:50   #5
@лeся
Пользователь
 
Аватар для @лeся
 
Регистрация: 04.01.2012
Сообщений: 44
Репутация: 18
По умолчанию

Ципихович Эндрю, мне кажется это несколько не то, с xls может они и не нужны будут,упор все таки на doc-овские файлы,но только не поняла,зачем их переименовывать и сохранять куда то,мне ведь просто необходимо их имя,или я неверно поняла код.

теоретически просто нужно выбрать несколько файлов,в частности dwg, doc , и что бы прога взяла их имена,в листбокс, и после этого можно вставить в данный документ.Т.е. физически трогать эти файлы и открывать мне нет необходимости вообще.

а с ubound у меня небольшая проблема,ведь там будет набор файлов с полным путем,надо каждый split-ить по "\", и взять именно последюю часть, ну как расширение обрубить я уже знаю (по Mid) .

т.е. в принципе

Код:
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        'Добавляется фильтр по типам файлов JPG и DOC.
        .Filters.Add "Images", "*.jpg; *.jpeg; *.doc; *.docx", 1
        .AllowMultiSelect = True            ' выбранно несколько файлов
        .InitialFileName = "D:\"

        If .Show = -1 Then
                 For Each vrtSelectedItem In .SelectedItems
                a = Mid(vrtSelectedItem, 1, Len(vrtSelectedItem) - 5) 
              '   a = Mid(vrtSelectedItem, 1, Len(vrtSelectedItem) - InStr(1, StrReverse(vrtSelectedItem), "."))
                 s() = Split(a, "\")
.........

у каждого отсекается расширение,но тут тоже проблема бывает расширение из 3 или 4 символов,способ отсечения после точки,не годится,потому что в именах файлов тоже бывают точки. как быть
@лeся вне форума   Ответить с цитированием
Старый 05.01.2012, 14:14   #6
Ципихович Эндрю
Профессионал
 
Регистрация: 24.01.2011
Сообщений: 2,305
Репутация: 52
По умолчанию

>расширение из 3 или 4 символов
ну дал же код
Код:
Полный_путь_к_файлу = f.Path
Имя_файла_с_расширением = f.Name
Имя_файла_без_расширения = CreateObject("Scripting.FileSystemObject").GetBaseName(f.Name)
Расширение_файла = CreateObject("Scripting.FileSystemObject").GetExtensionName(f)
осталось только цвет файла узнать
Ципихович Эндрю на форуме   Ответить с цитированием
Старый 05.01.2012, 14:22   #7
Пименов Александр
Форумчанин
 
Регистрация: 17.11.2010
Сообщений: 222
Репутация: 66
По умолчанию

Код:
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim Names() as String' Список имен файлов
    With fd
        'Добавляется фильтр по типам файлов JPG и DOC.
        .Filters.Add "Images", "*.jpg; *.jpeg; *.doc; *.docx", 1
        .AllowMultiSelect = True            ' выбранно несколько файлов
        .InitialFileName = "D:\"
i = 0
        If .Show = -1 Then
                 For Each vrtSelectedItem In .SelectedItems
                        i = i + 1
ReDim Preserve Names(1 to i) ' Активируем массив Names
                        s = Split(vrtSelectedItem, "\")
                            f = Split(s(UBound(s)), ".") 'Разбиваем последний элемент массива s на массив f с разделителем точка
'Если UBound(f)=1 to Names(i) = f(0) иначе объединяем все элементы массива кроме последнего
                            If UBound(f) = 1 Then
                                 Names(i) = f(0)
                            Else
                                 For j = 0 to UBound(f) - 1
                                      n = n & f(j)
                                 Next j
                                 Names(i) = n
                            End if
                 Next vrtSelectedItem
         End if
         ListBox1.List = Names
Пименов Александр вне форума   Ответить с цитированием
Старый 05.01.2012, 14:57   #8
Ципихович Эндрю
Профессионал
 
Регистрация: 24.01.2011
Сообщений: 2,305
Репутация: 52
По умолчанию

не спорю - сплит рулит, а чем не устраивает вариант из сообщения №6
Ципихович Эндрю на форуме   Ответить с цитированием
Старый 05.01.2012, 16:07   #9
@лeся
Пользователь
 
Аватар для @лeся
 
Регистрация: 04.01.2012
Сообщений: 44
Репутация: 18
По умолчанию

Цитата:
Сообщение от Ципихович Эндрю Посмотреть сообщение
не спорю - сплит рулит, а чем не устраивает вариант из сообщения №6
насколько я поняла,ну в принципе и применила пока,на данном этапе вариант покороче.
Код:
               s = Mid(vrtSelectedItem, 1, Len(vrtSelectedItem) - InStr(1, StrReverse(vrtSelectedItem), "."))
                 a = Mid(s, InStrRev(vrtSelectedItem, "\") + 1)
                 MsgBox "Selected item's FileName: " & a
                Me.ListBox1.AddItem a
               ActiveDocument.Content.InsertAfter Text:=a & vbCr
правда я немного чайник,хотела s и a в одну переменную объеденить,в одну строку ), не получается.
@лeся вне форума   Ответить с цитированием
Старый 05.01.2012, 16:18   #10
Ципихович Эндрю
Профессионал
 
Регистрация: 24.01.2011
Сообщений: 2,305
Репутация: 52
По умолчанию

>правда я немного чайник,хотела s и a в одну переменную объеденить,в одну строку ), не получается
что тут хотеть-то?
делаем просто переменную а = "мама мыла раму" и крутим её во все стороны, а потом всё остальное
Код:
' Используем функцию для извлечения
' указанного числа символов
' из слова колобок
Dim Mystring,retval
Mystring="колобок"
retval=Mid(Mystring,3,3)
Print retval ' возвращает лоб
и
' В данном примере функция InStr
' возвращает позицию первого появления
' одной строки внутри другой строки
Dim SearchString, SearchChar, MyPos
SearchString ="Русский_Проект"   ' Исходная строка
SearchChar = "Р"   ' Следует найти "P"

' Посимвольное сравнение, начиная с позиции 4. Возвращает 10
MyPos = Instr(4, SearchString, SearchChar, vbTextCompare)   

' Двоичное сравнение, начиная с позиции 1. Возвращает 1
MyPos = Instr(1, SearchString, SearchChar, 0)

' Сравнение является двоичным по умолчанию (последний аргумент опущен)
MyPos = Instr(SearchString, SearchChar)   ' Возвращает 1

MyPos = Instr(1, SearchString, "W")   ' Возвращает 0
Ципихович Эндрю на форуме   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
makefile: поменять имена файлов как? chechestor Общие вопросы C/C++ 1 14.01.2011 18:02
Как задать команду загрузки файлов данных на кнопку если каталог и имена файлов известны??? Andbuba Microsoft Office Excel 2 28.12.2008 18:28
Как вывести на экран имена файлов текущего каталога? (С++) Darw1n Помощь студентам 1 13.12.2008 12:10
Как получить имена нескольких файлов выделенных в OpenDialog Comer_Jus Общие вопросы Delphi 2 26.05.2008 19:47
как считать имена файлов из директории и поддерикторий в массив, ХЭЛП uraveselov Microsoft Office Excel 2 10.04.2008 09:50


15:47.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.