Table of Contents for Files

  • Thread starter Thread starter eggman4
  • Start date Start date
E

eggman4

Does anyone know of a way to populate a column with the names of files
that exist in a folder? I would like to use this to create a table of
contents for folders.
 
Hi! "eggman4 >",

Open "Notepad" and Select next-vbs-code,
and Copy it , then Paste it to new notepad file,
then save-as any name with extension of .vbs
( For example ListupFolderInXLS.vbs ) and make shortcut
onto the Desktop....
*** After making this code file with ,vbs extention
You can use it anytime you want.

1. you select any folder,
2. and drag it to this vbs-file's short-cut on the Desktop.
3. then this-vbs list it in Excel-sheet format (with Excel)
( Output list is edited into Sheet format with Excel. )
*** You can use or edit this Excel file whenever you like.

Good Luck!
===============================================================
Option Explicit
Dim Args, FS, WS, aFile, Buf, oFile
Set Args = WScript.Arguments
If Args.Count = 0 Then Reg_UnReg: WScript.Quit ' Registry/set or reset
If Args.Count <> 1 Then ShowUsage: WScript.Quit
Set FS = CreateObject("Scripting.FileSystemObject")
If Not FS.FolderExists(Args(0)) Then _
ShowUsage: Set FS = Nothing: WScript.Quit
Buf = "Name,Size,Type,Date Created,Date Updated" & vbCrLf
MakeList FS.GetFolder(Args(0)): oFile = FS.GetBaseName(Args(0))
' $B"-(B Right Click Short Cut menu Problem shooting
If oFile = "" Then oFile = FS.GetDrive(Args(0)).DriveLetter
oFile = FS.BuildPath(Args(0), oFile & ".csv")
Set aFile = FS.CreateTextFile(oFile, 2)
aFile.Write Buf: aFile.Close: Set aFile = Nothing: Set FS = Nothing
Set WS = CreateObject("WScript.Shell")
WS.Run "excel " & Chr(34) & oFile & Chr(34)
Set WS = Nothing: WScript.Quit
'
Sub ShowUsage
MsgBox " Please Drag Target Folder to this VBS-Program Icon " _
, vbOKOnly + vbInformation , "How To use this vbs. "
End Sub
'
Sub MakeList(aPath)
Dim Item
For Each Item In aPath.SubFolders: GetItemInfo(Item): Next
For Each Item In aPath.Files: GetItemInfo(Item): Next
End Sub
'
Sub GetItemInfo(aItem)
On Error Resume Next
Buf = Buf & Chr(34) & aItem.Name & Chr(34)
Buf = Buf & "," & Int(aItem.Size / 1024) + 1 & "KB"
Buf = Buf & "," & aItem.Type
Buf = Buf & "," & aItem.DateCreated
If Err.Number =5 Then Buf = Buf & "," : Err.Clear
Buf = Buf & "," & aItem.DateLastModified
Buf = Buf & vbCrLf
On Error Goto 0
End Sub
'
Sub Reg_UnReg
Const TKey = "HKCR\Folder\shell\FFList\"
Set WS = CreateObject("WScript.Shell")
On Error Resume Next
With WS
.RegRead TKey
If Err Then
.RegWrite Tkey , "Folder File List (&F)"
.RegWrite Tkey & "command\", _
"wscript """ & WScript.ScriptFullName & """ ""%1"""
.PopUp "Registered ", 1," Registry Completed "
Else
.RegDelete Tkey & "command\"
.RegDelete Tkey
.PopUp "Remove Registry-Setting", 1,"Removed setting"
End If
End With
On Error Goto 0
Set WS = Nothing
End Sub
====================================================================
 
eggman,

Here's one I've used:

Dim FileName As String
Dim ListPointer As Range
Set ListPointer = Sheets("Repertoire").Range("A1")
' get first file name
FileName = Dir(Range("RepertoireFolderPath") & "\*.*") ' or just
FileName = Dir("*.*")
Do While FileName <> ""
'If Right(FileName, 4) = "." & Range("FileType") Then
ListPointer = FileName
Set ListPointer = ListPointer.Offset(1, 0) ' move down
'End If
FileName = Dir() ' get another
Loop
 
Back
Top