Create file list

  • Thread starter Thread starter Gert-Jan
  • Start date Start date
G

Gert-Jan

Hi,

Can someone help me with the following:

I want a macro that creates a file list (starting in Sheet1, A1) of all
excel-files in a specific directory. But: the file itself (test.xls) should
not appear in that list and also not the names of the files wich have the
same name as one of the sheets in test.xls.
For example: if there is a workbook "apple.xls" AND test.xls contains a
sheet called "apple", apple.xls should not appear in the filelist. If apple
is NOT one of the sheetnames, apple.xls must be showed in the list.

Any help would be appriciated.

Gert-Jan
 
Hi Gert-Jan,

well, you got to compare the names of the
workbooks in the folder with the name
of the active workbook and, if unequal
to the name of the active workbook, with
the names of the worksheets in the active workbook.

What code have you got so far?


--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"
 
This will list the files. Suggest doing this first and then another for/each
loop macro with FINDNEXT to remove the undesired entries.

Here is one you can adapt using DIR

Sub anotherfindfiles()
Application.ScreenUpdating = False
Dim FN As String ' For File Name
Dim ThisRow As Long
Dim MediaFileLocation As String
MediaFileLocation = "c:\YOURFOLDER\*.YOURFILEEXTENSION"
FN = Dir(MediaFileLocation)
Do Until FN = ""
ThisRow = ThisRow + 1
Cells(ThisRow, 1) = FN
FN = Dir
Loop
Application.ScreenUpdating = True
End Sub
 
Sub ListFiles()
Dim sPath as String, sName as STring
Dim sName1 as String, bFound as Boolean
Dim i as Long, sh as Worksheet
sPath = Thisworkbook.Path
if right(sPath,1) <> "\" then sPath = sPath & "\"
sName = Dir(sPath & "*.xls")
do while sName <> ""
sName1 = Left(sName,len(sName)-4)
if lcase(sName) <> lcase(ThisWorkbook.Name) then
bFound = False
for each sh in Thisworkbook.Worksheets
if lcase(sName1) = lcase(sh.name) then
bfound = True
exit for
end if
Next
if not bFound then
i = i + 1
with worksheets("Sheet1")
.Cells(i,1) = sName
end with
end if
end if
sName = Dir
Loop
End Sub

Untested pseudo code should get you started.
 
Hi Don, thanks, but your solution doesn't work. I found this (history this
group), but I don't know how to change the last line: the message box should
not appear, data must be in list. Hope somone could help.

Sub AllExcelFilesInFolder()
Dim FileList() As String
Dim Counter As Long
Dim NextFile As String
Dim DirToSearch As String

DirToSearch = "C:\Exceldok" 'the folder name
Counter = 0


NextFile = Dir(DirToSearch & "\" & "*.xls")


Do Until NextFile = ""
ReDim Preserve FileList(Counter)
FileList(Counter) = DirToSearch & "\" & NextFile
Counter = Counter + 1
NextFile = Dir()
Loop


For Counter = LBound(FileList) To UBound(FileList)
MsgBox FileList(Counter)
'do your stuff here instead of previous line
Next
End Sub
 
Thanks Tom, this works fine!

Regards, Gert-Jan

Tom Ogilvy said:
Sub ListFiles()
Dim sPath as String, sName as STring
Dim sName1 as String, bFound as Boolean
Dim i as Long, sh as Worksheet
sPath = Thisworkbook.Path
if right(sPath,1) <> "\" then sPath = sPath & "\"
sName = Dir(sPath & "*.xls")
do while sName <> ""
sName1 = Left(sName,len(sName)-4)
if lcase(sName) <> lcase(ThisWorkbook.Name) then
bFound = False
for each sh in Thisworkbook.Worksheets
if lcase(sName1) = lcase(sh.name) then
bfound = True
exit for
end if
Next
if not bFound then
i = i + 1
with worksheets("Sheet1")
.Cells(i,1) = sName
end with
end if
end if
sName = Dir
Loop
End Sub

Untested pseudo code should get you started.
Click to expand...
 
The only problem with Don's code was that ThisRow was never defined. Once it
is defined, the code creates a list of file names. Good job, Don. i will
probably use this elsewhere.
 
Back
Top