Как скопировать имена выбранных файлов в Listbox?

[@лeся]

Здравствуйте.
Может я плохо ориентируюсь в справках,но не могу найти как вытащить именно имена файлов и собрать их в 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ся]

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

п.с. но от помощи не откажусь

[Ципихович Эндрю]

делайте под себя

'предварительно нужно добавить ссылку на 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

[Казанский]

Можно использовать Split:

dim x
'...
x=split(.vrtSelectedItem,"\")
MsgBox "Selected item's FileName: " & x(ubound(x))

Но мне больше нравится так:

MsgBox "Selected item's FileName: " & mid$(.vrtSelectedItem,instrrev(.vrtSelectedItem,"\")+1)

[@лeся]

Ципихович Эндрю, мне кажется это несколько не то, с 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 символов,способ отсечения после точки,не годится,потому что в именах файлов тоже бывают точки. как быть

[Ципихович Эндрю]

>расширение из 3 или 4 символов
ну дал же код

Полный_путь_к_файлу = f.Path
Имя_файла_с_расширением = f.Name
Имя_файла_без_расширения = CreateObject("Scripting.FileSystemObject").GetBaseName(f.Name)
Расширение_файла = CreateObject("Scripting.FileSystemObject").GetExtensionName(f)

осталось только цвет файла узнать

[Пименов Александр]

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

[Ципихович Эндрю]

не спорю - сплит рулит, а чем не устраивает вариант из сообщения №6

[@лeся]

Сообщение от Ципихович Эндрю

не спорю - сплит рулит, а чем не устраивает вариант из сообщения №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 в одну переменную объеденить,в одну строку ), не получается.

[Ципихович Эндрю]

>правда я немного чайник,хотела 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