این ماکرو با این کار به شما امکان می دهد تا به صورت بصری از طریق فهرست های رایانه های خود حرکت کنید تا زمانی که شخصی را که می خواهید پیدا کنید و سپس با کلیک بر روی دکمه OK ، کلیه پرونده های آن پوشه به اکسل منتقل می شوند. هر پرونده خروجی پسوند پرونده خود را همراه با آن خواهد داشت.
ستون دوم از داده ها بصورت پیش فرض تولید می شود که اندازه پرونده را در بایت ها شامل می شود. برای جلوگیری از ظاهر شدن آن ، آن خط کد را در زیر جایی که می گوید این کار را در کد انجام دهید ، اظهار نظر کنید.
توجه: وقتی این ماکرو را اجرا می کنید ، هیچ فایلی در دایرکتوری ها ظاهر نمی شود. این به این دلیل است که شما به جای فایلهای جداگانه ، دایرکتوری را انتخاب می کنید.
Sub GetFileNames()
Dim xRow As Long
Dim xDirect, xFname
Dim Dest As Range
'Change this to put the data in a different place in the workbook.
'ActiveCell places the data in the currently selected cell and below.
Set Dest = ActiveCell
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Select a folder"
.Show
If .SelectedItems.Count <> 0 Then
xDirect = .SelectedItems(1) & "\"
xFname = Dir(xDirect, 7)
Do While xFname <> ""
Dest.Offset(xRow) = xFname
'remove the next line to prevent displaying the file size (in bytes)
Dest.Offset(xRow, 1) = FileLen(xDirect & xFname)
xRow = xRow + 1
xFname = Dir
Loop
End If
End With
End Sub

ورود به سایت