Folder summary of workbooks - solved

ROBINSYN

Board Regular
Joined
Aug 19, 2002
Messages
188
Is there anyway to summarize the filenames in a folder even after new additions. Can this be done with excel or do I need a program?

Thanks for the incite> WORKS LIKE A CHARM
This message was edited by ROBINSYN on 2002-09-07 13:07
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

XL-Dennis

Well-known Member
Joined
Jul 27, 2002
Messages
1,920
ROBINSYN,

What do You mean with summarize?

- List all filenames in a folder in worksheet

Kind regards,
Dennis
 

Ivan F Moala

MrExcel MVP
Joined
Feb 10, 2002
Messages
4,209
Hi
If you mean File details in a sheets of certain Dir then this may help you.

<PRE><FONT color=#339966>'---------------------------------------------------------------------------------------
</FONT>
<FONT color=#339966>' Module : Mod_DirInfo
</FONT>
<FONT color=#339966>' DateTime : 8/01/01 18:06
</FONT>
<FONT color=#339966>' Author : Ivan F Moala
</FONT>
<FONT color=#339966>' Purpose : Lists xls File info
</FONT>
<FONT color=#339966>' Inputs : Directory
</FONT>
<FONT color=#339966>' Outputs : Full path name of file,size Kb of file,Date time of File
</FONT>
<FONT color=#339966>'---------------------------------------------------------------------------------------
</FONT>
<FONT color=blue>Option Explicit</FONT>

<FONT color=blue>Option Base</FONT> 1



<FONT color=blue>Dim </FONT>KbSum <FONT color=blue>As</FONT><FONT color=blue> Double</FONT>

<FONT color=blue>Const </FONT>Dmsg = "Select the Directory to get xls File info from"



<FONT color=#339966>'// Code for generating list of files in a directory...
</FONT>
<FONT color=#339966>'// 32-bit API declarations
</FONT>
Declare <FONT color=blue>Function </FONT>SHGetPathFromIDList Lib "shell32.dll" _

Alias "SHGetPathFromIDListA" ( _

<FONT color=blue>ByVal</FONT> pidl <FONT color=blue>As</FONT><FONT color=blue> Long</FONT>, _

<FONT color=blue>ByVal</FONT> pszPath <FONT color=blue>As</FONT><FONT color=blue> String</FONT>) <FONT color=blue>As</FONT><FONT color=blue> Long</FONT>



Declare <FONT color=blue>Function </FONT>SHBrowseForFolder Lib "shell32.dll" _

Alias "SHBrowseForFolderA" ( _

lpBrowseInfo <FONT color=blue>As</FONT> BROWSEINFO) <FONT color=blue>As</FONT><FONT color=blue> Long</FONT>



Public<FONT color=blue> Type</FONT> BROWSEINFO

hOwner <FONT color=blue>As</FONT><FONT color=blue> Long</FONT>

pidlRoot <FONT color=blue>As</FONT><FONT color=blue> Long</FONT>

pszDisplayName <FONT color=blue>As</FONT><FONT color=blue> String</FONT>

lpszTitle <FONT color=blue>As</FONT><FONT color=blue> String</FONT>

ulFlags <FONT color=blue>As</FONT><FONT color=blue> Long</FONT>

lpfn <FONT color=blue>As</FONT><FONT color=blue> Long</FONT>

lParam <FONT color=blue>As</FONT><FONT color=blue> Long</FONT>

iImage <FONT color=blue>As</FONT><FONT color=blue> Long</FONT>

End<FONT color=blue> Type</FONT>



<FONT color=blue>Function </FONT>GetDirectory(Optional Msg <FONT color=blue>As</FONT><FONT color=blue> String</FONT>) <FONT color=blue>As</FONT><FONT color=blue> String</FONT>

<FONT color=blue>Dim </FONT>bInfo <FONT color=blue>As</FONT> BROWSEINFO

<FONT color=blue>Dim </FONT>path <FONT color=blue>As</FONT><FONT color=blue> String</FONT>

<FONT color=blue>Dim </FONT>r <FONT color=blue>As</FONT><FONT color=blue> Long</FONT>, x <FONT color=blue>As</FONT><FONT color=blue> Long</FONT>, pos <FONT color=blue>As</FONT><FONT color=blue> Integer</FONT>

<FONT color=#339966>'// Root folder = Desktop
</FONT>
bInfo.pidlRoot = 0&

<FONT color=#339966>'// Title in the dialog
</FONT>
<FONT color=blue>If </FONT>IsMissing(Msg) Then

bInfo.lpszTitle = "Select a folder."

<FONT color=blue>Else</FONT>

bInfo.lpszTitle = Msg

<FONT color=blue>End If</FONT>

<FONT color=#339966>'// Type of directory to return
</FONT>
bInfo.ulFlags = &H1

<FONT color=#339966>'// Display the dialog
</FONT>
x = SHBrowseForFolder(bInfo)

<FONT color=#339966>'// Parse the result
</FONT>
path = Space$(512)

r = SHGetPathFromIDList(<FONT color=blue>ByVal</FONT> x, <FONT color=blue>ByVal</FONT> path)

<FONT color=blue>If </FONT>r Then

pos = InStr(path, Chr$(0))

GetDirectory = Left(path, pos - 1)

<FONT color=blue>Else</FONT>

GetDirectory = ""

<FONT color=blue>End If</FONT>



<FONT color=blue>End Function</FONT>



<FONT color=blue>Function </FONT>GetFileList(FileSpec <FONT color=blue>As</FONT><FONT color=blue> String</FONT>) <FONT color=blue>As</FONT><FONT color=blue> Variant</FONT>

<FONT color=#339966>'// Returns an array of filenames that match FileSpec
</FONT>
<FONT color=#339966>'// If no matching files are found, it returns False
</FONT>
<FONT color=blue>Dim </FONT>FileSearch

<FONT color=blue>Dim </FONT>FileArray() <FONT color=blue>As</FONT><FONT color=blue> Variant</FONT>

<FONT color=blue>Dim </FONT>i <FONT color=blue>As</FONT><FONT color=blue> Double</FONT>

<FONT color=blue>Dim </FONT>Exists



<FONT color=blue>On Error</FONT> <FONT color=blue>GoTo</FONT> ErrSearch

<FONT color=blue>Set </FONT>FileSearch = Application.FileSearch



<FONT color=blue>If </FONT>Right(FileSpec, 1) <> ""<FONT color=blue> Then </FONT>FileSpec = FileSpec & ""



Exists = Dir(FileSpec)

<FONT color=blue>If </FONT>Exists = ""<FONT color=blue> Then </FONT><FONT color=blue>GoTo</FONT> ErrSearch



<FONT color=#339966>'// Reset KbSum
</FONT>
KbSum = 0

<FONT color=blue>With </FONT>FileSearch

.NewSearch

.LookIn = FileSpec

.FileName = "*.xls"

<FONT color=blue>If </FONT>.Execute > 0 Then

Re<FONT color=blue>Dim </FONT>FileArray(.FoundFiles.Count, 3)

<FONT color=blue>For </FONT>i = 1 <FONT color=blue>To </FONT>.FoundFiles.Count

FileArray(i, 1) = .FoundFiles(i)

KbSum = KbSum + FileLen(.FoundFiles(i)) 1024

FileArray(i, 2) = FileLen(.FoundFiles(i)) 1024 & " Kb"

FileArray(i, 3) = Format(FileDateTime(.FoundFiles(i)), "dd/mm/yy hh:mm:ss")

<FONT color=blue>Next</FONT>

<FONT color=blue>Else</FONT>

GetFileList =<FONT color=blue> False</FONT>

Exit Function

<FONT color=blue>End If</FONT>

<FONT color=blue>End With</FONT>



GetFileList = FileArray



<FONT color=blue>Set </FONT>FileSearch =<FONT color=blue> Nothing</FONT>



Exit Function

<FONT color=#339966>'// Error handler
</FONT>
ErrSearch:



<FONT color=blue>If </FONT>Exists = ""<FONT color=blue> Then </FONT><FONT color=blue>On Error</FONT> <FONT color=blue>Resume </FONT><FONT color=blue>Next</FONT>: Err.Raise 76

MsgBox Err.Number & " : " & Err.Description, vbMsgBoxHelpButton, _

"Error Search", Err.HelpFile, Err.HelpContext

End

<FONT color=blue>End Function</FONT>



<FONT color=blue>Sub </FONT>ListToSheet_FileInfo()

<FONT color=blue>Dim </FONT>Dir_ToLookIn <FONT color=blue>As</FONT><FONT color=blue> String</FONT>, x <FONT color=blue>As</FONT><FONT color=blue> Variant</FONT>, i <FONT color=blue>As</FONT><FONT color=blue> Double</FONT>



Dir_ToLookIn = GetDirectory(Dmsg)

<FONT color=blue>If </FONT>Dir_ToLookIn = ""<FONT color=blue> Then </FONT><FONT color=blue>Exit Sub</FONT>



x = GetFileList(Dir_ToLookIn)



Select <FONT color=blue>Case </FONT>IsArray(x)



Case<FONT color=blue> True</FONT> <FONT color=#339966>'// Files found
</FONT>


ActiveSheet.<FONT color=blue>Range</FONT>("A:C").Clear

[A1] = UBound(x) & " Files in Dir:= " & Dir_ToLookIn

[B1] = KbSum & " Kb"

[C1] = "File<FONT color=blue> Date</FONT>"



<FONT color=blue>With </FONT><FONT color=blue>Range</FONT>("A1:C1")

.HorizontalAlignment = xlCenter

.Font.Bold =<FONT color=blue> True</FONT>

.Font.ColorIndex = 5

<FONT color=blue>End With</FONT>

<FONT color=blue>With </FONT>ActiveSheet

.<FONT color=blue>Range</FONT>("A2").Resize(UBound(x), 3) = x

.<FONT color=blue>Range</FONT>("A:C").Columns.AutoFit

<FONT color=blue>End With</FONT>

MsgBox "Done!....", vbInformation



Case<FONT color=blue> False</FONT> <FONT color=#339966>'// No files found
</FONT>
MsgBox "No matching files", vbCritical



<FONT color=blue>End Select</FONT>



x = ""



<FONT color=blue>End Sub</FONT>
</PRE>
 

XL-Dennis

Well-known Member
Joined
Jul 27, 2002
Messages
1,920
Ivan,

Thanks for a nice piece of code although I´m still prefer the "FSO"-approach (i e less lines of code) but I realize more and more the power of API.

Kind regards,
Dennis
 

Mudface

MrExcel MVP
Joined
Feb 18, 2002
Messages
3,339

ADVERTISEMENT

FSO, pah! :biggrin:.
 

XL-Dennis

Well-known Member
Joined
Jul 27, 2002
Messages
1,920
Mudface,

Hehe, the only reason You´ve got is that You don´t has any sample of the FSO-approach :p

Here it come and don´t forget to set a reference to the Microsoft Scripting Runtime via the Tools | Reference.

<PRE>


<FONT color=blue>Sub </FONT>List_Files()

<FONT color=blue>Dim </FONT>fsoObj<FONT color=blue> As</FONT> Scripting.FileSystemObject

<FONT color=blue>Dim </FONT>fsoMapp<FONT color=blue> As</FONT> Scripting.Folder

<FONT color=blue>Dim </FONT>fsoFil<FONT color=blue> As</FONT> Scripting.File

<FONT color=blue>Dim </FONT>i<FONT color=blue> As</FONT><FONT color=blue> Long</FONT>



<FONT color=blue>Set </FONT>fsoObj =<FONT color=blue> New </FONT>Scripting.FileSystemObject

<FONT color=blue>Set </FONT>fsoMapp = fsoObj.GetFolder("e:Arbetsmaterial")



<FONT color=blue>With </FONT>Range("A1:H1")

.Value = Array("Filename", "Created", "Last changed", "Size", "Type", _

"Drive", "Folder", "Path")

.Font.Bold =<FONT color=blue> True</FONT>

<FONT color=blue>End With</FONT>



i = 0

<FONT color=blue>If </FONT>Not fsoMapp Is<FONT color=blue> Nothing</FONT> Then

<FONT color=blue>For </FONT>Each fsoFil In fsoMapp.Files

<FONT color=blue>If </FONT>fsoFil Like "*.xls" Then

i = i + 1

<FONT color=blue>With </FONT>fsoFil

Cells(1 + i, 1).Value = .Name

Cells(1 + i, 2).Value = .DateCreated

Cells(1 + i, 3).Value = .DateLastModified

Cells(1 + i, 4).Value = .Size

Cells(1 + i, 5).Value = .Type

Cells(1 + i, 6).Value = .Drive

Cells(1 + i, 7).Value = .ParentFolder

Cells(1 + i, :cool:.Value = .Path

<FONT color=blue>End With</FONT>

<FONT color=blue>End If</FONT>

Next

<FONT color=blue>End If</FONT>



Columns("A:H").EntireColumn.AutoFit



<FONT color=blue>Set </FONT>fsoFil =<FONT color=blue> Nothing</FONT>

<FONT color=blue>Set </FONT>fsoMapp =<FONT color=blue> Nothing</FONT>

<FONT color=blue>Set </FONT>fsoObj =<FONT color=blue> Nothing</FONT>

<FONT color=blue>End Sub</FONT>


</PRE>

Kind regards,
Dennis
 

Mudface

MrExcel MVP
Joined
Feb 18, 2002
Messages
3,339

ADVERTISEMENT

Dennis, I was just messing :). Remember yesterday's post, where the guy couldn't set a reference to the scripting library?
 

Ivan F Moala

MrExcel MVP
Joined
Feb 10, 2002
Messages
4,209
On 2002-09-07 12:51, XL-Dennis wrote:
Ivan,

Thanks for a nice piece of code although I´m still prefer the "FSO"-approach (i e less lines of code) but I realize more and more the power of API.

Kind regards,
Dennis

Hi Dennis
Yes I agree...this was just one of many approaches....for instance the whole API approach can be taken out with this...

<pre/>
Set objFolder = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please Select Image Folder", 0, GetDrive)

If Not objFolder Is Nothing Then
'// Is it the Root Dir?...if so change
If Len(objFolder.Items.Item.Path) > 3 Then
strPictFullPath = objFolder.Items.Item.Path & Application.PathSeparator
Else
strPictFullPath = objFolder.Items.Item.Path
End If
</pre>

and many other ways.....I just had the above handy (written) last year.
Note: FSO for searching is slower then native VBA Filesearch....
 

XL-Dennis

Well-known Member
Joined
Jul 27, 2002
Messages
1,920
Mudface,

Yes, I know You was joking so did I :wink:

Ivan,
Yes, I agree that the native VBA Filesearch is the preferable approach :)

However, I´m always amazed over the fact that You seems to have "an ace up Your sleeve" :wink:

Have a nice weekend,
Dennis
 

Ivan F Moala

MrExcel MVP
Joined
Feb 10, 2002
Messages
4,209
On 2002-09-07 13:37, XL-Dennis wrote:
Mudface,

Yes, I know You was joking so did I :wink:

Ivan,
Yes, I agree that the native VBA Filesearch is the preferable approach :)

However, I´m always amazed over the fact that You seems to have "an ace up Your sleeve" :wink:

Have a nice weekend,
Dennis

Dennis my friend :)

Have a GREAT Weekend....

BTW....I have taken a copy of your routine
:biggrin:

_________________
Kind Regards,<font size=+2><font color="red"> I<font color="blue">van<font color="red"> F M</font color="blue">oala</font><font size=1> From the City of Sails
image.gif

This message was edited by Ivan F Moala on 2002-09-07 14:01
 

Watch MrExcel Video

Forum statistics

Threads
1,129,750
Messages
5,638,133
Members
417,010
Latest member
jnuss03

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top