Для выбранных файлов получить тип файла и имя файла

Question

Для каждого выбранного файла я пытаюсь получить тип файла. Прямо сейчас я могу просто получить имя файла. В настоящее время у меня есть следующий код здесь, но мне было интересно, если это тоже было возможно. Я заимствую некоторый код из donPablo (ссылка здесь: VBA Excel FileDialog возвращает выбранный элемент в качестве объекта )

Мой код:

Dim fPath               As Variant
Dim FirstRow            As Long
Dim SelectedAutoCADfile As Integer
Dim vFiles              As Object
Dim objFolder         As Object              'This object allows you to create, delete, move or query a folder hierarchy.
Dim objFile           As Object              'This object allows you to create, delete, move or query a File

Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
Set fPath = Application.FileDialog(msoFileDialogFilePicker)
With fDialog

.Title = "Please select the files"   'Title of Window Pop-up
.InitialFileName = Range("F12")      'This is the shortcut pathway
.AllowMultiSelect = True             'Allow the user to multiselect
.Filters.Clear                       'Clear all filters
.Filters.Add "DWG Files", "*.dwg"    'Only show AutoCAD files

ThisWorkbook.Sheets(1).Range("F12") = .SelectedItems(1)     'Document Pathway

FirstRow = Row + Sheet8.Range("D99999").End(xlUp).Row + 1 'First Available Row

Set objFSO = CreateObject("scripting.FileSystemObject") 'Create the File System Object
Set objFolder = objFSO.GetFolder(FolderSelected) 'Create the File System Folder

If .Show = True Then  'If the user selected some files

    For SelectedAutoCADfile = 1 To .SelectedItems.Count 'For each of the files the user selected

       Sheet7.Cells(FirstRow, 4) = Dir(.SelectedItems(SelectedAutoCADfile)) 'Writes the filename to each cell
       Cells(Row, 5) = objFile.Type                'Places the FileType in this column

       FirstRow = FirstRow + 1                                                   
       'Go to next available row
      Next
    Next
   'Go to next file
End If
End With

Answer 1

Это можно сделать довольно просто, используя объект Scripting.File:

Dim fDialog ' your code doesn't specify which type this should be
Dim fPath As Variant
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
Set fPath = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
    .Title = "Please select the files"
    .InitialFileName = Range("F12")
    .AllowMultiSelect = True
    .Filters.Clear
    .Filters.Add "DWG Files", "*.dwg"
End With

If Not fDialog.Show Then Exit Sub ' if within a Function, then set the function value and Exit Function instead of Exit Sub

' Not sure why you need to do this here
ThisWorkbook.Sheets(1).Range("F12") = fDialog.SelectedItems(1)

Dim nextRow As Long
nextRow = FirstRow = Row + Sheet8.Range("D99999").End(xlUp).Row + 1

' Add a reference to Microsoft Scripting Runtime (via Tools -> References...)

Dim fso As New Scripting.FileSystemObject
Dim fle As Scripting.File
Dim selectedFilename as Variant
For Each selectedFilename In fDialog.SelectedItems
    Set fle = fso.GetFile(selectedFilename)
    Sheet7.Cells(nextRow, 4) = fle.Name
    Sheet7.Cells(nextRow, 5) = fle.Type
    Debug.Print fle.ParentFolder.Path ' Prints the parent folder's path to the Debug window
    nextRow = nextRow + 1
Next

---

Ссылки

• FileSystemObject - GetFile метод
• Файловый объект - Имя , Тип и ParentFolder свойства
• объект папки - путь свойство