Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Old May 11th 05, 02:26 PM
Greg B
 
Posts: n/a
Default Files in a directory?

Is there anyway to have excel list files in a dirctory?

Thanks in advance.

Greg



  #2   Report Post  
Old May 11th 05, 02:45 PM
Harald Staff
 
Posts: n/a
Default

Hi Greg

Here's a set of code that does it. Paste in a standard module:

Option Explicit

Enum BrowseForFolderFlags
BIF_RETURNONLYFSDIRS = &H1
BIF_DONTGOBELOWDOMAIN = &H2
BIF_STATUSTEXT = &H4
BIF_BROWSEFORCOMPUTER = &H1000
BIF_BROWSEFORPRINTER = &H2000
BIF_BROWSEINCLUDEFILES = &H4000
BIF_EDITBOX = &H10
BIF_RETURNFSANCESTORS = &H8
End Enum

Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHBrowseForFolder Lib _
"shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib _
"shell32" (ByVal pidList As Long, _
ByVal lpBuffer As String) As Long

Private Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
Dim Writerow As Long


Public Function BrowseForFolder(hWnd As Long, _
Optional Title As String, _
Optional Flags As BrowseForFolderFlags) As String

Dim iNull As Integer
Dim IDList As Long
Dim Result As Long
Dim Path As String
Dim bi As BrowseInfo

If Flags = 0 Then Flags = BIF_RETURNONLYFSDIRS
With bi
.lpszTitle = lstrcat(Title, "")
.ulFlags = Flags
End With

IDList = SHBrowseForFolder(bi)
If IDList Then
Path = String$(300, 0)
Result = SHGetPathFromIDList(IDList, Path)
iNull = InStr(Path, vbNullChar)
If iNull Then Path = Left$(Path, iNull - 1)
End If
BrowseForFolder = Path
End Function



Sub ListMyFiles()
Dim DirToSearch As String
Dim WithSubFolders As Boolean
Writerow = ActiveSheet.Cells(65000, 1).End(xlUp).Row + 1
DirToSearch = BrowseForFolder(858, _
"Choose a folder:", BIF_DONTGOBELOWDOMAIN)
If DirToSearch < "" Then
WithSubFolders = (MsgBox("Include subfolders ?", _
vbYesNo + vbQuestion, "Files in " & DirToSearch) = vbYes)
GetFilesInDirectory DirToSearch
If WithSubFolders Then LookForDirectories (DirToSearch)
End If
End Sub

Sub LookForDirectories(ByVal DirToSearch As String)
Dim counter As Integer
Dim i As Integer
Dim Directories() As String
Dim Contents As String

counter = 0
DirToSearch = DirToSearch & "\"
Contents = Dir(DirToSearch, vbDirectory)
Do While Contents < ""
If Contents < "." And Contents < ".." Then
If (GetAttr(DirToSearch & Contents) And _
vbDirectory) = vbDirectory Then
counter% = counter% + 1
ReDim Preserve Directories(counter)
Directories(counter) = DirToSearch & Contents
End If
End If
Contents = Dir
Loop
If counter = 0 Then Exit Sub
For i = 1 To counter
GetFilesInDirectory Directories(i)
LookForDirectories Directories(i)
Next i
End Sub

Sub GetFilesInDirectory(ByVal DirToSearch As String)
Dim NextFile As String
On Error Resume Next
With ActiveSheet
NextFile = Dir(DirToSearch & "\" & "*.*")
Do Until NextFile = ""
.Cells(Writerow, 1) = DirToSearch & "\"
.Cells(Writerow, 2) = NextFile
.Cells(Writerow, 3) = FileDateTime(DirToSearch & _
"\" & NextFile)
.Cells(Writerow, 4) = Format(FileLen(DirToSearch & _
"\" & NextFile) / 1024, "# ##0 Kb")
Writerow = Writerow + 1
NextFile = Dir()
Loop
End With
End Sub

HTH. Best wishes Harald

"Greg B" skrev i melding
...
Is there anyway to have excel list files in a dirctory?

Thanks in advance.

Greg




  #3   Report Post  
Old May 11th 05, 02:46 PM
Bob Phillips
 
Posts: n/a
Default

Option Explicit


Dim FSO As Object
Dim cnt As Long
Dim arfiles
Dim level As Long


Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean

Set FSO = CreateObject("Scripting.FileSystemObject")

arfiles = Array()
cnt = -1
level = 1

sFolder = "c:\myTest"
ReDim arfiles(6, 0)
If sFolder < "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(6, i))
.Value = arfiles(5, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(6, i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(5, i)
.Cells(i + 1, arfiles(6, i) + 1).Value = arfiles(1, i)
.Cells(i + 1, arfiles(6, i) + 2).Value = arfiles(2, i)
.Cells(i + 1, arfiles(6, i) + 3).Value = arfiles(3, i)
.Cells(i + 1, arfiles(6, i) + 4).Value = arfiles(4, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").Columns.AutoFit
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False


End Sub

'-----------------------------**-----------------------------*-*------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------**-----------------------------*-*------------
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(6, cnt)
arfiles(0, cnt) = ""
arfiles(5, cnt) = arPath(level - 1)
arfiles(6, cnt) = level

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(6, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = Right(oFile.Name, Len(oFile.Name) - _
InStrRev(oFile.Name, "."))
arfiles(2, cnt) = Format(oFile.DateCreated, "dd mmm yyyy")
arfiles(3, cnt) = Format(oFile.Size, "#,##0")
arfiles(4, cnt) = oFile.Path
arfiles(5, cnt) = oFile.Name
arfiles(6, cnt) = level + 1
Next oFile

level = level + 1
For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next
level = level - 1

End Sub


#If VBA6 Then
#Else
'-----------------------------*------------------------------*------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------*------------------------------*------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues

If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If

sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") &
"""}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next

Split = aryValues

End Function

#End If



--
HTH

Bob Phillips

"Greg B" wrote in message
...
Is there anyway to have excel list files in a dirctory?

Thanks in advance.

Greg




  #4   Report Post  
Old May 11th 05, 02:56 PM
Don Guillett
 
Posts: n/a
Default

Here are a couple you might try

Sub GetFileList()
Dim iCtr As Integer
With Application.FileSearch
.NewSearch
.LookIn = "c:\aa"
.SearchSubFolders = True
.Filename = ".xls"
If .Execute 0 Then
For iCtr = 1 To .FoundFiles.Count
Cells(iCtr, 1).Value = .FoundFiles(iCtr)
Next iCtr
End If
End With
End Sub

Sub FindExcelFiles()
Application.ScreenUpdating = False
Dim FN As String ' For File Name
Dim ThisRow As Long
Dim FileLocation As String
FileLocation = "c:\ahorse\*.xls"
FN = Dir(FileLocation)
Do Until FN = ""
ThisRow = ThisRow + 1
Cells(ThisRow, 1) = FN
FN = Dir
Loop
Application.ScreenUpdating = True
End Sub
--
Don Guillett
SalesAid Software

"Greg B" wrote in message
...
Is there anyway to have excel list files in a dirctory?

Thanks in advance.

Greg




  #5   Report Post  
Old May 11th 05, 04:06 PM
Greg B
 
Posts: n/a
Default

Thanks for that

Greg
"Don Guillett" wrote in message
...
Here are a couple you might try

Sub GetFileList()
Dim iCtr As Integer
With Application.FileSearch
.NewSearch
.LookIn = "c:\aa"
.SearchSubFolders = True
.Filename = ".xls"
If .Execute 0 Then
For iCtr = 1 To .FoundFiles.Count
Cells(iCtr, 1).Value = .FoundFiles(iCtr)
Next iCtr
End If
End With
End Sub

Sub FindExcelFiles()
Application.ScreenUpdating = False
Dim FN As String ' For File Name
Dim ThisRow As Long
Dim FileLocation As String
FileLocation = "c:\ahorse\*.xls"
FN = Dir(FileLocation)
Do Until FN = ""
ThisRow = ThisRow + 1
Cells(ThisRow, 1) = FN
FN = Dir
Loop
Application.ScreenUpdating = True
End Sub
--
Don Guillett
SalesAid Software

"Greg B" wrote in message
...
Is there anyway to have excel list files in a dirctory?

Thanks in advance.

Greg








Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Maintain cell links when renaming directory containing multiple f Excel52 Excel Worksheet Functions 0 April 28th 05 10:54 PM
put files together Jack Sons Excel Discussion (Misc queries) 7 March 21st 05 09:23 PM
Load all files in a directory Greg B... Excel Discussion (Misc queries) 2 March 2nd 05 12:22 PM
change directory for refresh data TxRaistlin Excel Discussion (Misc queries) 0 February 7th 05 09:09 PM
multiple text files URGENT tasha Excel Discussion (Misc queries) 1 December 19th 04 05:44 PM


All times are GMT +1. The time now is 09:59 PM.

Powered by vBulletin® Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
Copyright 2004-2019 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Copyright © 2017