worksheet with content of a directory

[Jack Sons]

Hi all,

The Word VBA code below produces a Word document with the content of a
directory.

1. I want to use it in Excel VBA in stead of Word VBA, so in a Excel VBA
module (probably in personal.xls?) producing an Excel worksheet.
2. Furthermore I want it to result in two colums. The left column with
the names of the document, a it works now, and the right column with the
dates of the most recent change of the documents. In fact just like it
appears in my Explorer.

Your help will be appreciated.

Jack Sons
The Netherlands


------------------------------------------------------------------------------------------------------------
Sub Inhoud_Directory()

Dim PathWanted As String
Dim Temp As String
Dim i As Integer

With Dialogs(wdDialogFileOpen)
.Name = "*.*"
If .Display = -1 Then
'Documents.Add

PathWanted = Options.DefaultFilePath(wdDocumentsPath)
Set newdoc = Documents.Add
With newdoc
.Content.Font.Name = "Times New Roman"
.SaveAs FileName:=PathWanted
End With

Selection.TypeText "Files in " & PathWanted & ":" & vbCrLf
With Application.FileSearch
.LookIn = PathWanted
.FileName = "*.*"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Temp = .FoundFiles(i)
While InStr(Temp, "\") > 0
Temp = Mid(Temp, InStr(Temp, "\") + 1)
Wend
Selection.TypeText Temp & vbCrLf
Next
End If
End With
End If
End With
End Sub

 

[stanleydgromjr]

Jack Sons,

See:
Leith Ross
'List files in folder - Excel Help Forum' (http://tinyurl.com/n9ktdl)


Have a great day,
Sta

 

[Jack Sons]

Stan,

Thanks for your help. I got the code, but don't know how to work with it (as
it is now it does nothing). I do not understand the "example".
If I have to fill in somewhere the complete path (often very long) of the
directory that I want to list, it could be very cumbersome. Is an easier way
possible? The code in my original posting works on any opened directory that
appears in my Explorer, no need to type in a long path. Is that also
possible with Leith's code when (a bit) augmented?

I also do not understand Randy's reply; "had to change the objFolderItem
from "8" to "9"". Why? What does it mean?

I look forward to your assistance.

Jack.

 

[Dave Peterson]

Application.filesearch was dropped in xl2007. And in earlier versions, it was
kind of flakey.

John Walkenbach has some code here:

That will allow you to pick a folder.

I copied directly from his site and put this in its own module. (I can only
screw it up, so I put it somewhere I won't touch).

Option Explicit
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _
As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg) As String
'from John Walkenbach's site:
'http://spreadsheetpage.com/index.php/tip/selecting_a_directory/


Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

' Root folder = Desktop
bInfo.pidlRoot = 0&

' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' Type of directory to return
bInfo.ulFlags = &H1

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function

======================
Then in a different module, I put this:

Option Explicit
Dim oRow As Long
Dim wks As Worksheet
Sub Inhoud_Directory()
Dim PathWanted As String

Dim fCtr As Long
Dim iCtr As Long

'a new single sheet workbook
Set wks = Workbooks.Add(1).Worksheets(1)

PathWanted = GetDirectory

If PathWanted = "" Then
Exit Sub 'user hit cancel
End If

oRow = 0
Call FoldersInFolder(PathWanted)

wks.UsedRange.Columns.AutoFit

End Sub
Sub FoldersInFolder(myFolderName As String)

' with a reference to microsoft scripting runtime
' Dim FSO As Scripting.FileSystemObject
' Dim myBaseFolder As Scripting.Folder
' Dim myFolder As Scripting.Folder
' dim myFile as Scripting.File
' Set FSO = New Scripting.FileSystemObject

' without the reference
Dim FSO As Object
Dim myBaseFolder As Object
Dim myFolder As Object
Dim myFile As Object

Set FSO = CreateObject("scripting.filesystemobject")

Set myBaseFolder = FSO.GetFolder(myFolderName)

oRow = oRow + 1
With wks.Cells(oRow, "A")
.Value = myFolderName
.Font.Bold = True
.Font.ColorIndex = 3
End With

For Each myFile In myBaseFolder.Files
oRow = oRow + 1
With wks.Cells(oRow, "A")
.NumberFormat = "@" 'text
.Value = myFile.Name
End With
With wks.Cells(oRow, "B")
.NumberFormat = "dd-mmm-yyyy hh:mm:ss"
.Value = myFile.datelastmodified
End With
Next myFile

For Each myFolder In myBaseFolder.SubFolders
Call FoldersInFolder(myFolder.path)
Next myFolder

End Sub

It doesn't do quite what you asked, but maybe you'll find it more useful.

If not, you can just comment out (or delete) this section:

For Each myFolder In myBaseFolder.SubFolders
Call FoldersInFolder(myFolder.path)
Next myFolder

 

[Dave Peterson]

John's site (I forget to paste it in my text):
http://spreadsheetpage.com/index.php/tip/selecting_a_directory/

Application.filesearch was dropped in xl2007. And in earlier versions, it was
kind of flakey.

John Walkenbach has some code here:

That will allow you to pick a folder.

<<snipped>>