File Contents List

You can do pretty much the same.

1) Open Command Prompt.

2) Navigate to the folder in question.

3) Type "DIR >filelist.txt"

Job done.

I use a nice little freebie called "PrintFolder" that works great for this. You can even set it up for right-click context menu use, such that you right-click on a directory (folder), and chose the option to use PrintFolder, and it will send the folder file list to a .txt file and open it. There is a "pro" version that gives more options, but I've never needed more than the free version offers. Here's a link to a download page. I have actually downloaded the install file and installed it on my computer from this location, so I feel pretty confident you can trust the site.

LINK

Tom D.

I'd vote for PrintFolder, I've used this little programme for ages & it works well, lets you chose how much information is displayed.

Another DOS command that will work: DIR /s > NAME.txt

This will list directories and files. You can then cut and paste the file contents into Excel and use the 'Text to Column' option to separate and/or sort.

I haven't used the programs the others posted, but will be trying them.

all true above

MSO Excel VBA can do some stuff extra

' //// [ThisWorkbook] code ////

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
If Sh.Name = "Sheet1" Then
If Target.SubAddress = "Sheet1!A1" Then
UserForm1.Show 1 ' if Cell A1 on Sheet1 (containing HREF to itself) was cliked open the UserForm
Else
MsgBox Target.SubAddress ' incase i messed up something with hyperlink
End If
Else
MsgBox Sh.Name ' incase the sheet name was invalid
End If
End Sub

' //// [UserForm1] code ////
' //// if i recon right it creates list of photos to copy from dir tree
' //// to a common folder for my mom so she could sort her stuff
' //// there was an issue with nation speciffic characters
' //// such as õäöü(Estonian) & Cyrillic & Turkish & Czech
' //// you can create such ^^ filenames but the windows filesystem
' //// doesnot fully support (codewise manipulation) them
' ////
' //// u likely want to check the ' /\/\/\/\ Get File Info /\/\/\/\ below
' //// gives you access to some file attributes the %SystemRoot%\system32\cmd.exe doesnot

Option Explicit
Option Base 0

Private Type dtRec
y4 As Long
mm As Long
dd As Long
End Type

Private Type tmRec
tm As Long
hh As Long
mm As Long
ss As Long
ms As Long
End Type

Private Type tmrREC
t0 As Double
t1 As Double
t2 As Double
End Type

Dim intTMR As tmrREC

Private Sub UserForm_Initialize()
SetINTtmR 10
MsgBox "Hi!"
End Sub

Private Sub UserForm_Terminate()
MsgBox "Bye!"
End Sub

'Private Sub CommandButton1_Click(): Call Master: End Sub
Private Sub CommandButton1_Click(): Call Master2: End Sub

Private Sub CommandButton2_Click(): Call tmTest: End Sub

' \\\\\\\\\\\\\\\\\\\\\\\\\\
' //////// Main SUB ////////
' \\\\\\\\\\\\\\\\\\\\\\\\\\

Private Sub Master()

Dim ff, ss$, fa
Dim opst#, done, cc

done = 0: cc = 5 * 60
ChDrive "i": ChDir "\": MsgBox LCase(CurDir), , "-- 1 --"
ChDir "i:\tmp": MsgBox LCase(CurDir), , "-- 2 --"

'opst = Shell("cmd /C dir *.txt /s/b > dir1.txt", vbNormalFocus)
opst = Shell("cmd /C dir *.* /a/s/b > dir1.txt", vbNormalFocus)
DoEvents ' -=<>=- /!\ -=<>=- DoEvents -=<>=- /!\ -=<>=-

' *** ff = FreeFile: cc = 3
' *** Open ("i:\tmp\dir1.txt") For Input As ff

While Test4FileIsOpen("i:\tmp\dir1.txt") And (cc > 0)
SetINTtmR
cc = cc + (cc > 0)
Do
DoEvents ' -=<>=- /!\ -=<>=- DoEvents -=<>=- /!\ -=<>=-
Loop Until iTTo
Wend

' *** Close ff

ff = FreeFile: Open ("i:\tmp\dir1.txt") For Input As ff: Seek ff, 1

Do While Not EOF(ff)
Line Input #ff, ss
fa = GetAttr(ss)
' file.FileType
MsgBox ss & vbLf & Math_FRM(Math_BIN(fa), 32) & vbLf & make_FAS(fa), , "-- 3 --"
Loop

Close ff

MsgBox "-=- Done! -=-", , "-- 4 --"

End Sub

' \\\\\\\\\\\\\\\\\\\\\\\\\\\\
' //////// Main SUB 2 ////////
' \\\\\\\\\\\\\\\\\\\\\\\\\\\\

Private Sub Master2()

Dim ff, gg, ss$, ww$, fa
Dim opst#, done, cc
Dim fct&, fxt$

done = 0: cc = 5 * 60
ChDrive "d": ChDir "\": MsgBox LCase(CurDir), , "-- 1 --"
ChDir "D:\Digikaamera pildid": MsgBox LCase(CurDir), , "-- 2 --"

DoEvents ' -=<>=- /!\ -=<>=- DoEvents -=<>=- /!\ -=<>=-

'opst = Shell("cmd /C dir *.txt /s/b > dir1.txt", vbNormalFocus)
opst = Shell("cmd /C dir *.* /a/s/b > dir1.txt", vbNormalFocus)

DoEvents ' -=<>=- /!\ -=<>=- DoEvents -=<>=- /!\ -=<>=-

' *** ff = FreeFile: cc = 3
' *** Open ("i:\tmp\dir1.txt") For Input As ff

While Test4FileIsOpen("D:\Digikaamera pildid\dir1.txt") And (cc > 0)
SetINTtmR
cc = cc + (cc > 0)
Do
DoEvents ' -=<>=- /!\ -=<>=- DoEvents -=<>=- /!\ -=<>=-
Loop Until iTTo
Wend

' *** Close ff

fct = 0

ff = FreeFile: Open ("D:\Digikaamera pildid\dir1.txt") For Input As ff: Seek ff, 1
gg = FreeFile: Open ("D:\Digikaamera pildid\ren1.txt") For Output As gg: Seek gg, 1

'Do While Not EOF(ff) And (fct < 10)
Do While Not EOF(ff)
Line Input #ff, ss
ss = Trim(ss)
fa = GetAttr(ss)
If (fa And vbDirectory) = 0 Then
fxt = LCase(Right(ss, 3))
If (fxt = "avi") Or (fxt = "bmp") Or (fxt = "gif") Or _
(fxt = "jpe") Or (fxt = "jpg") Or (fxt = "mov") Or _
(fxt = "mp4") Or (fxt = "mpg") Then
fct = fct + 1
TextBox1.Text = TextBox2.Text
TextBox2.Text = ss
TextBox3.Text = fct
ww = "copy """ & ss & """ ""F:\[Fotod]\" & GetFleInf(ss) & "[" & Math_FRM(fct, 5) & "]." & fxt & """"
Print #gg, ww
DoEvents
End If
Else
DoEvents
End If
Loop

Close gg, ff

MsgBox "Found " & fct & " items" & vbLf & "-=- Done! -=-", , "-- 4 --"

End Sub

' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' //////// Timer Calendary ////////
' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Private Sub SetINTtmR(Optional ByVal i As Double = 1)
With intTMR
.t1 = i
.t0 = Timer
.t2 = .t0 + .t1
End With
End Sub

Private Function iTTo() As Boolean
iTTo = (intTMR.t2 < Timer) Or (Timer < intTMR.t0)
End Function

Private Sub tmTest()
Dim tmr, dtm: tmr = Timer: dtm = Time
MsgBox tmr & vbLf & dtm & vbLf & tmVal(dtm)
End Sub

Private Function tmVal&(ByVal dtm)
Dim ss1, ss2, ss3
Dim rZa(64), tt As tmRec
Dim xx1, xx2, xx3, done
done = 0: Erase rZa
ss1 = ":": ss2 = dtm & ss1
xx1 = 1: xx2 = Len(dtm)
Do
xx3 = InStr(xx1, ss2, ss1, vbBinaryCompare)
rZa(0) = rZa(0) + 1
rZa(rZa(0)) = xx3
xx1 = xx3 + 1
done = xx1 > xx2
Loop Until done
With tt
.hh = Val(Trim(Mid(dtm, rZa(1) - 2, 2)))
.mm = Val(Trim(Mid(dtm, rZa(2) - 2, 2)))
.ss = Val(Trim(Mid(dtm, rZa(2) + 1, 2)))
.tm = (.hh * 60 + .mm) * 60 + .ss
End With
tmVal = tt.tm
End Function

' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' //////// FILE ACCESS ////////
' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Private Function Test4FileIsOpen(ByVal strFileName As String) As Boolean ' TRUE on File_is_Open (-ed by another App)
Test4FileIsOpen = FileLocked(strFileName)
End Function

Private Function FileLocked(ByVal strFileName As String) As Boolean ' TRUE on File_is_Locked (by another Application)
Dim R, tfv
R = False
On Error Resume Next
tfv = FreeFile
Open strFileName For Binary Access Read Write Lock Read Write As tfv
Close tfv
If Err.Number <> 0 Then
' MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
Err.Clear
UserForm1.Caption = "!!! File is Locked"
R = True
Else
UserForm1.Caption = "File is Free from Handlers !!!"
End If
FileLocked = R
End Function

Private Function make_FAS$(ByVal i&)
Dim R$, rr$
If i = vbNormal Then
R = "Normal"
Else
If (i And vbReadOnly) <> 0 Then R = "(0:1) is Read-only" Else R = "(0:1) -- -- --"
rr = R
If (i And vbHidden) <> 0 Then R = "(1:2) is Hidden" Else R = "(0:1) -- -- --"
rr = rr & vbLf & R
If (i And vbSystem) <> 0 Then R = "(2:4) is System" Else R = "(0:1) -- -- --"
rr = rr & vbLf & R
If (i And 8) <> 0 Then R = "(3:8) is Attribute bit-8 Set" Else R = "(0:1) -- -- --"
rr = rr & vbLf & R
If (i And vbDirectory) <> 0 Then R = "(4:16) is Directory" Else R = "(0:1) -- -- --"
rr = rr & vbLf & R
If (i And vbArchive) <> 0 Then R = "(5:32) is Changed" Else R = "(0:1) -- -- --"
rr = rr & vbLf & R
If (i And vbAlias) <> 0 Then R = "(6:64) is Alias" Else R = "(0:1) -- -- --"
R = rr & vbLf & R
End If
make_FAS = R
End Function

' ===============================
' /\/\/\/\ Get File Info /\/\/\/\
' ===============================

Private Function GetFleInf$(filespec)
Dim fs, f, s, ss$(2), st, i, k
' s = ParseFlNm(filespec)
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(filespec)
ss(0) = ParseDate(f.DateCreated)
ss(1) = ParseDate(f.DateLastAccessed)
ss(2) = ParseDate(f.DateLastModified)
' s = s & f.Name & vbLf
' s = s & " in " & f.ParentFolder & vbLf
' s = s & "First Created: " & f.DateCreated & " << " & ss(0) & vbLf
' s = s & "Last Accessed: " & f.DateLastAccessed & " << " & ss(1) & vbLf
' s = s & "Last Modified: " & f.DateLastModified & " << " & ss(2) & vbLf
For k = 0 To 1
For i = k + 1 To 2
If ss(k) > ss(i) Then
st = ss(k): ss(k) = ss(i): ss(i) = st
End If
Next i
Next k
' s = s & "Least Date: " & ss(0)
' MsgBox s, 0, "File Access Info"
GetFleInf = ss(0)
End Function

Private Function ParseFlNm$(filespec)
Dim done, trgS, trgL, tagS
Dim x1, x2
Dim R$
done = 0
tagS = "\"
trgS = filespec & tagS
trgL = Len(trgS)
x1 = 0
R = "v v v v"
Do
x1 = x1 + 1
x2 = InStr(x1, trgS, tagS, vbBinaryCompare)
R = R & vbLf & Mid(trgS, x1, x2 - x1)
x1 = x2
done = x1 >= trgL
Loop Until done
ParseFlNm = R & vbLf & "^ ^ ^ ^"
End Function

Private Function ParseDate$(dttm)
Dim dte As dtRec
Dim tme As tmRec
Dim dtmp(1, 6)
Dim done, trgS, trgL, tagS, tstS
Dim x1, x2
Dim R$
trgS = ">" & Trim(dttm) & "<"
trgL = Len(trgS)
tagS = trgS & ":"
If InStr(1, tagS, ":", vbBinaryCompare) > trgL Then
trgS = trgS & "00:00:00<"
trgL = Len(trgS)
End If
For x1 = 1 To trgL
tstS = Asc(Mid(trgS, x1, 1))
If (tstS < 48) Or (tstS > 57) Then
dtmp(0, x2) = x1
x2 = x2 + 1
End If
Next x1
For x1 = 0 To 5
dtmp(1, x1) = dtmp(0, x1 + 1) - dtmp(0, x1) - 1
dtmp(0, x1) = dtmp(0, x1) + 1
Next x1
With dte
.dd = Val(Trim(Mid(trgS, dtmp(0, 0), dtmp(1, 0))))
.mm = Val(Trim(Mid(trgS, dtmp(0, 1), dtmp(1, 1))))
.y4 = Val(Trim(Mid(trgS, dtmp(0, 2), dtmp(1, 2))))
End With
With tme
.hh = Val(Trim(Mid(trgS, dtmp(0, 3), dtmp(1, 3))))
.mm = Val(Trim(Mid(trgS, dtmp(0, 4), dtmp(1, 4))))
.ss = Val(Trim(Mid(trgS, dtmp(0, 5), dtmp(1, 5))))
End With
'ParseDate = Math_FRM(dte.y4, 4) & "." & _
Math_FRM(dte.mm, 2) & "." & _
Math_FRM(dte.dd, 2) & " " & _
Math_FRM(tme.hh, 2) & ":" & _
Math_FRM(tme.mm, 2) & ":" & _
Math_FRM(tme.ss, 2)
ParseDate = Math_FRM(dte.y4, 4) & Math_FRM(dte.mm, 2) & Math_FRM(dte.dd, 2) & _
Math_FRM(tme.hh, 2) & Math_FRM(tme.mm, 2) & Math_FRM(tme.ss, 2)
End Function

' \\\\\\\\\\\\\\\\\\\\\\\\\\\
' //////// BASE MATH ////////
' \\\\\\\\\\\\\\\\\\\\\\\\\\\

Private Function Math_FRM$(ByVal i$, ByVal l&): Dim R$, cl&: cl = Len(i)
If l > cl Then R = String(l - cl, "0") & i Else R = i
Math_FRM = R
End Function

Private Function Math_BIN$(ByVal i&)
Dim R$
If i > 1 Then R = Math_BIN(i \ 2) + Chr(&H30& + i Mod 2) Else R = Chr(&H30& + i)
Math_BIN = R
End Function

'[END OVER & OUT]