Excel VBA FileSystemObject GetFolder - PullRequest
Новая
       25

Excel VBA FileSystemObject GetFolder

0 голосов
/ 07 февраля 2019

Я хотел бы иметь возможность получить информацию о файле в списке путей, которые я ввожу в диапазон ячеек.Я также не хочу получать все подпапки либо.У меня есть этот код, который отлично работает, используя 1 путь к папке. 

Sub Get_Information()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")

Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File

Dim last_row As Integer

sh.Rows(1).Font.Size = 18

Set fo = fso.GetFolder(sh.Range("H1").Value)

For Each f In fo.Files
    last_row = sh.Range("A" & Application.Rows.Count).End(xlUp).Row + 1

    sh.Range("A" & last_row).Value = f.Name
    sh.Range("B" & last_row).Value = f.Type
    sh.Range("C" & last_row).Value = f.Size / 1024
    sh.Range("D" & last_row).Value = f.DateLastModified

Next

MsgBox ("Done")

1 Ответ

0 голосов
/ 07 февраля 2019

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

Sub Get_Information()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")

Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Dim pathArray as Variant
Dim SplitString as String    

Dim last_row As Integer

sh.Rows(1).Font.Size = 18

SplitString = sh.Range("H1").Value
pathArray = Split(SplitString, ";") 'change to whatever seperator you are using

For each pth in pathArray

    Set fo = fso.GetFolder(pth)

    For Each f In fo.Files
        last_row = sh.Range("A" & Application.Rows.Count).End(xlUp).Row + 1

        sh.Range("A" & last_row).Value = f.Name
        sh.Range("B" & last_row).Value = f.Type
        sh.Range("C" & last_row).Value = f.Size / 1024
        sh.Range("D" & last_row).Value = f.DateLastModified

    Next f

Next pth
MsgBox ("Done")

РЕДАКТИРОВАТЬ

Если вывместо этого вы хотите просмотреть диапазон ячеек: 

Sub Get_Information()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")

Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Dim c as Range

Dim last_row As Integer

sh.Rows(1).Font.Size = 18

For each pth in sh.Range("H1:H" & last_row) 'Edit range
  If not pth.value = ""
    Set fo = fso.GetFolder(c.Value)

    For Each f In fo.Files
        last_row = sh.Range("A" & Application.Rows.Count).End(xlUp).Row + 1

        sh.Range("A" & last_row).Value = f.Name
        sh.Range("B" & last_row).Value = f.Type
        sh.Range("C" & last_row).Value = f.Size / 1024
        sh.Range("D" & last_row).Value = f.DateLastModified

    Next f

  End If
Next pth
MsgBox ("Done")
...