The code below is used to select files which will then be zipped up and saved
to a location. I am trying to automate the process completly to avoid the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use the Dir
command to return a list of the files just like i get inthe immediate window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over $1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) & Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

Dir doesn't return an array. See the help example for Dir to see how to use
it.

Perhaps you want to use FileFind or the filesystemobject in the scripting
runtime library.
--
Regards,
Tom Ogilvy

"Jeff" wrote in message
...
The code below is used to select files which will then be zipped up and
saved
to a location. I am trying to automate the process completly to avoid the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use the
Dir
command to return a list of the files just like i get inthe immediate
window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over
$1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) & Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

The following function will return an array of filenames along with their
full path and can be used to optionally search subfolders. Don't forget to
reference Scripting Runtime (see comments below):

Public Function FilesFullName(argPath As String, argType As String,
argSearchSubFolders As Boolean) As Variant
'USES PARTIAL PATH AND FILE TYPE IN WILDCARD FORMAT (E.G. *.*; *.XLS; ETC.);
'FUNCTION RETURNS LIST OF FULL FILE NAMES IN PATH - OPTIONALLY SEARCH
SUBFOLDERS
'REQUIRED REFERENCE: MICROSOFT SCRIPTING RUNTIME
Dim ofsSearch As FileSearch
Dim ofsFound As FoundFiles
Dim lngX As Long
Dim varFullName() As Variant
Set ofsSearch = Application.FileSearch
With ofsSearch
.NewSearch
.SearchSubFolders = argSearchSubFolders
.Filename = argType
.LookIn = argPath
.Execute msoSortByFileName
End With
Set ofsFound = ofsSearch.FoundFiles
For lngX = 1 To ofsFound.Count
ReDim Preserve varFullName(lngX)
varFullName(lngX) = ofsFound(lngX)
Next lngX
FilesFullName = varFullName
End Function

HTH.

"Jeff" wrote:

The code below is used to select files which will then be zipped up and saved
to a location. I am trying to automate the process completly to avoid the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use the Dir
command to return a list of the files just like i get inthe immediate window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over $1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) & Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

Actually, that doesn't use the scripting runtime at all and requires no
reference to the scripting runtime.

That uses the filesearch object which is part of office.

--
Regards,
Tom Ogilvy

"quartz" wrote in message
...
The following function will return an array of filenames along with their
full path and can be used to optionally search subfolders. Don't forget to
reference Scripting Runtime (see comments below):

Public Function FilesFullName(argPath As String, argType As String,
argSearchSubFolders As Boolean) As Variant
'USES PARTIAL PATH AND FILE TYPE IN WILDCARD FORMAT (E.G. *.*; *.XLS;
ETC.);
'FUNCTION RETURNS LIST OF FULL FILE NAMES IN PATH - OPTIONALLY SEARCH
SUBFOLDERS
'REQUIRED REFERENCE: MICROSOFT SCRIPTING RUNTIME
Dim ofsSearch As FileSearch
Dim ofsFound As FoundFiles
Dim lngX As Long
Dim varFullName() As Variant
Set ofsSearch = Application.FileSearch
With ofsSearch
.NewSearch
.SearchSubFolders = argSearchSubFolders
.Filename = argType
.LookIn = argPath
.Execute msoSortByFileName
End With
Set ofsFound = ofsSearch.FoundFiles
For lngX = 1 To ofsFound.Count
ReDim Preserve varFullName(lngX)
varFullName(lngX) = ofsFound(lngX)
Next lngX
FilesFullName = varFullName
End Function

HTH.

"Jeff" wrote:

The code below is used to select files which will then be zipped up and
saved
to a location. I am trying to automate the process completly to avoid
the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use the
Dir
command to return a list of the files just like i get inthe immediate
window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over
$1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) &
Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

Thanks Tom. You are right of course, I think I just failed to clean up the
code after working with something else.

"Tom Ogilvy" wrote:

Actually, that doesn't use the scripting runtime at all and requires no
reference to the scripting runtime.

That uses the filesearch object which is part of office.

--
Regards,
Tom Ogilvy

"quartz" wrote in message
...
The following function will return an array of filenames along with their
full path and can be used to optionally search subfolders. Don't forget to
reference Scripting Runtime (see comments below):

Public Function FilesFullName(argPath As String, argType As String,
argSearchSubFolders As Boolean) As Variant
'USES PARTIAL PATH AND FILE TYPE IN WILDCARD FORMAT (E.G. *.*; *.XLS;
ETC.);
'FUNCTION RETURNS LIST OF FULL FILE NAMES IN PATH - OPTIONALLY SEARCH
SUBFOLDERS
'REQUIRED REFERENCE: MICROSOFT SCRIPTING RUNTIME
Dim ofsSearch As FileSearch
Dim ofsFound As FoundFiles
Dim lngX As Long
Dim varFullName() As Variant
Set ofsSearch = Application.FileSearch
With ofsSearch
.NewSearch
.SearchSubFolders = argSearchSubFolders
.Filename = argType
.LookIn = argPath
.Execute msoSortByFileName
End With
Set ofsFound = ofsSearch.FoundFiles
For lngX = 1 To ofsFound.Count
ReDim Preserve varFullName(lngX)
varFullName(lngX) = ofsFound(lngX)
Next lngX
FilesFullName = varFullName
End Function

HTH.

"Jeff" wrote:

The code below is used to select files which will then be zipped up and
saved
to a location. I am trying to automate the process completly to avoid
the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use the
Dir
command to return a list of the files just like i get inthe immediate
window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over
$1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) &
Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

This is going to sound stupid but how do I call the function? I have tried to
call it by simply inserting its name and parenthatiese, I've tried calling it
by passing the arguments "FileNameXls(MyPath, ".xls", 0)"

all to no avail

"quartz" wrote:

The following function will return an array of filenames along with their
full path and can be used to optionally search subfolders. Don't forget to
reference Scripting Runtime (see comments below):

Public Function FilesFullName(argPath As String, argType As String,
argSearchSubFolders As Boolean) As Variant
'USES PARTIAL PATH AND FILE TYPE IN WILDCARD FORMAT (E.G. *.*; *.XLS; ETC.);
'FUNCTION RETURNS LIST OF FULL FILE NAMES IN PATH - OPTIONALLY SEARCH
SUBFOLDERS
'REQUIRED REFERENCE: MICROSOFT SCRIPTING RUNTIME
Dim ofsSearch As FileSearch
Dim ofsFound As FoundFiles
Dim lngX As Long
Dim varFullName() As Variant
Set ofsSearch = Application.FileSearch
With ofsSearch
.NewSearch
.SearchSubFolders = argSearchSubFolders
.Filename = argType
.LookIn = argPath
.Execute msoSortByFileName
End With
Set ofsFound = ofsSearch.FoundFiles
For lngX = 1 To ofsFound.Count
ReDim Preserve varFullName(lngX)
varFullName(lngX) = ofsFound(lngX)
Next lngX
FilesFullName = varFullName
End Function

HTH.

"Jeff" wrote:

The code below is used to select files which will then be zipped up and saved
to a location. I am trying to automate the process completly to avoid the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use the Dir
command to return a list of the files just like i get inthe immediate window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over $1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) & Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

Dim Varr as Variant
varr = FilesFullName(MyPath, ".xls", False)


unless you changed the function name.

--
Regards,
Tom Ogilvy



"Jeff" wrote in message
...
This is going to sound stupid but how do I call the function? I have tried
to
call it by simply inserting its name and parenthatiese, I've tried calling
it
by passing the arguments "FileNameXls(MyPath, ".xls", 0)"

all to no avail

"quartz" wrote:

The following function will return an array of filenames along with
their
full path and can be used to optionally search subfolders. Don't forget
to
reference Scripting Runtime (see comments below):

Public Function FilesFullName(argPath As String, argType As String,
argSearchSubFolders As Boolean) As Variant
'USES PARTIAL PATH AND FILE TYPE IN WILDCARD FORMAT (E.G. *.*; *.XLS;
ETC.);
'FUNCTION RETURNS LIST OF FULL FILE NAMES IN PATH - OPTIONALLY SEARCH
SUBFOLDERS
'REQUIRED REFERENCE: MICROSOFT SCRIPTING RUNTIME
Dim ofsSearch As FileSearch
Dim ofsFound As FoundFiles
Dim lngX As Long
Dim varFullName() As Variant
Set ofsSearch = Application.FileSearch
With ofsSearch
.NewSearch
.SearchSubFolders = argSearchSubFolders
.Filename = argType
.LookIn = argPath
.Execute msoSortByFileName
End With
Set ofsFound = ofsSearch.FoundFiles
For lngX = 1 To ofsFound.Count
ReDim Preserve varFullName(lngX)
varFullName(lngX) = ofsFound(lngX)
Next lngX
FilesFullName = varFullName
End Function

HTH.

"Jeff" wrote:

The code below is used to select files which will then be zipped up
and saved
to a location. I am trying to automate the process completly to avoid
the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use
the Dir
command to return a list of the files just like i get inthe immediate
window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over
$1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) &
Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

Something like this will do it:


Function GetFilesInFolder(FileSpec As String) As Variant

'Returns an array of filenames that match FileSpec
'If no matching files are found, it returns False
'-------------------------------------------------

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String

On Error GoTo NoFilesFound

FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound

'Loop until no more matching files are found
Do While FileName < ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop

GetFilesInFolder = FileArray

Exit Function
NoFilesFound:

On Error GoTo 0
GetFilesInFolder = False

End Function

Sub test()

Dim arrFiles
Dim i As Long

arrFiles = GetFilesInFolder("C:\*.txt")

For i = 1 To UBound(arrFiles)
MsgBox arrFiles(i)
Next

End Sub


RBS


"Jeff" wrote in message
...
The code below is used to select files which will then be zipped up and
saved
to a location. I am trying to automate the process completly to avoid the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use the
Dir
command to return a list of the files just like i get inthe immediate
window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over
$1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) & Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

Here is some nice code from Randy Birch to do a recursive filesearch with
the Windows API:
http://vbnet.mvps.org/index.html?cod...es_minimal.htm

RBS


"Jeff" wrote in message
...
The code below is used to select files which will then be zipped up and
saved
to a location. I am trying to automate the process completly to avoid the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use the
Dir
command to return a list of the files just like i get inthe immediate
window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over
$1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) & Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

http://support.microsoft.com/default...b;en-us;185476
How To Search Directories to Find or List Files

this is a link to that article for the third method
http://support.microsoft.com/kb/185601/EN-US/
HOW TO: Recursively Search Directories by Using FileSystemObject

--
Regards,
Tom Ogilvy

"RB Smissaert" wrote in message
...
Here is some nice code from Randy Birch to do a recursive filesearch with
the Windows API:
http://vbnet.mvps.org/index.html?cod...es_minimal.htm

RBS


"Jeff" wrote in message
...
The code below is used to select files which will then be zipped up and
saved
to a location. I am trying to automate the process completly to avoid
the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use the
Dir
command to return a list of the files just like i get inthe immediate
window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over
$1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) & Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

Thanks.

With the MS example I managed something to make that works with the dir
function. It will need a bit of refinement:

Function FindFiles(path As String, _
SearchStr As String, _
FileCount As Long, _
DirCount As Long) As Variant

Dim FileName As String 'Walking filename variable.
Dim DirName As String 'SubDirectory Name.
Dim dirNames() As String 'Buffer for directory name entries.
Dim nDir As Integer 'Number of directories in this path.
Dim i As Integer 'For-loop counter.
Static arrFiles

If FileCount = 0 Then
ReDim arrFiles(1 To 10000000) As String
End If

On Error GoTo sysFileERR

If Right(path, 1) < "\" Then
path = path & "\"
End If

'Search for subdirectories.
nDir = 0

ReDim dirNames(nDir)
DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _
Or vbSystem) 'Even if hidden, and so on.

Do While Len(DirName) 0
'Ignore the current and encompassing directories.
If (DirName < ".") And (DirName < "..") Then
'Check for directory with bitwise comparison.
If GetAttr(path & DirName) And vbDirectory Then
dirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If 'directories.
sysFileERRCont:
End If
DirName = Dir() 'Get next subdirectory.
Loop

'Search through this directory and sum file sizes.
FileName = Dir(path & SearchStr, _
vbNormal Or _
vbHidden Or _
vbSystem Or _
vbReadOnly Or _
vbArchive)

While Len(FileName) < 0
FileCount = FileCount + 1
arrFiles(FileCount) = path & FileName
FileName = Dir() 'Get next file.
Wend

'If there are sub-directories..
If nDir 0 Then
'Recursively walk into them
For i = 0 To nDir - 1
FindFiles path & dirNames(i) & "\", _
SearchStr, _
FileCount, _
DirCount
Next
End If

FindFiles = arrFiles

AbortFunction:
Exit Function
sysFileERR:
If Right(DirName, 4) = ".sys" Then
Resume sysFileERRCont 'Known issue with pagefile.sys
Else
MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
"Unexpected Error"
Resume AbortFunction
End If

End Function

Sub test()

Dim i As Long
Dim arr

arr = FindFiles("C:\TestFolder", _
"*.txt", _
0, _
0)

For i = 1 To 1000000
Cells(i, 1) = arr(i)
If arr(i) = "" Then
MsgBox i - 1
Exit For
End If
Next

End Sub


RBS




"Tom Ogilvy" wrote in message
...
http://support.microsoft.com/default...b;en-us;185476
How To Search Directories to Find or List Files

this is a link to that article for the third method
http://support.microsoft.com/kb/185601/EN-US/
HOW TO: Recursively Search Directories by Using FileSystemObject

--
Regards,
Tom Ogilvy

"RB Smissaert" wrote in message
...
Here is some nice code from Randy Birch to do a recursive filesearch with
the Windows API:
http://vbnet.mvps.org/index.html?cod...es_minimal.htm

RBS


"Jeff" wrote in message
...
The code below is used to select files which will then be zipped up and
saved
to a location. I am trying to automate the process completly to avoid
the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use the
Dir
command to return a list of the files just like i get inthe immediate
window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over
$1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) &
Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

Have worked this out now and it is actually very fast and it finds some
files that the routine with
the API didn't find.
A file the API routine missed was:
C:\RBSSynergyReporting\LinkFiles\Smissaert - promote - 1599., 7E04., 7E043,
7E045, 7E046, 7F1A0, 685H.TXT
Haven't looked yet why this would be.

As somebody might find it useful here the code:


Function FindFiles(strPath As String, _
strSearch As String, _
Optional lFileCount As Long = 0, _
Optional lDirCount As Long = 0) As String()

'adapted from the MS example:
'http://support.microsoft.com/default.aspx?scid=kb;en-us;185476
'---------------------------------------------------------------
'will list all the files in the supplied folder and it's
'subfolders that fit the strSearch criteria
'lFileCount and lDirCount will always have to start as 0
'use for example like this:
'Dim arr
'arr = FindFiles("C:\TestFolder", "*.xls")
'---------------------------------------------------------------

Dim strFileName As String 'Walking strFileName variable.
Dim strDirName As String 'SubDirectory Name.
Dim arrDirNames() As String 'Buffer for directory name entries.
Dim nDir As Integer 'Number of directories in this strPath.
Dim i As Integer 'For-loop counter.
Static strStartDirName As String
Static arrFiles

On Error GoTo sysFileERR

If Right(strPath, 1) < "\" Then
strPath = strPath & "\"
End If

If lFileCount = 0 And lDirCount = 0 Then
ReDim arrFiles(1 To 10000000) As String
strStartDirName = strPath
End If

'Search for subdirectories.
nDir = 0

ReDim arrDirNames(nDir)
strDirName = Dir(strPath, vbDirectory Or vbHidden Or vbArchive Or
vbReadOnly _
Or vbSystem) 'Even if hidden, and so
on.

Do While Len(strDirName) 0
'Ignore the current and encompassing directories.
If (strDirName < ".") And (strDirName < "..") Then
'Check for directory with bitwise comparison.
If GetAttr(strPath & strDirName) And vbDirectory Then
arrDirNames(nDir) = strDirName
lDirCount = lDirCount + 1
nDir = nDir + 1
ReDim Preserve arrDirNames(nDir)
End If 'directories.
sysFileERRCont:
End If
strDirName = Dir() 'Get next subdirectory.
Loop

'Search through this directory
strFileName = Dir(strPath & strSearch, _
vbNormal Or _
vbHidden Or _
vbSystem Or _
vbReadOnly Or _
vbArchive)

While Len(strFileName) < 0
lFileCount = lFileCount + 1
arrFiles(lFileCount) = strPath & strFileName
strFileName = Dir() 'Get next file.
Wend

'If there are sub-directories..
If nDir 0 Then
'Recursively walk into them
For i = 0 To nDir - 1
FindFiles strPath & arrDirNames(i) & "\", _
strSearch, _
lFileCount, _
lDirCount
Next
End If

'searching the supplied main directory is done last
'so that is when we redim and supply the produced array
'------------------------------------------------------
If strPath & arrDirNames(i) = strStartDirName Then
ReDim Preserve arrFiles(1 To lFileCount)
FindFiles = arrFiles
End If

AbortFunction:
Exit Function
sysFileERR:
If Right(strDirName, 4) = ".sys" Then
Resume sysFileERRCont 'Known issue with pagefile.sys
Else
MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
"Unexpected Error"
Resume AbortFunction
End If

End Function


Sub test()

Dim i As Long
Dim arr

arr = FindFiles("C:\TestFolder", "*.xls")

For i = 1 To UBound(arr)
Cells(i, 1) = arr(i)
Next

End Sub


RBS


"Tom Ogilvy" wrote in message
...
http://support.microsoft.com/default...b;en-us;185476
How To Search Directories to Find or List Files

this is a link to that article for the third method
http://support.microsoft.com/kb/185601/EN-US/
HOW TO: Recursively Search Directories by Using FileSystemObject

--
Regards,
Tom Ogilvy

"RB Smissaert" wrote in message
...
Here is some nice code from Randy Birch to do a recursive filesearch with
the Windows API:
http://vbnet.mvps.org/index.html?cod...es_minimal.htm

RBS


"Jeff" wrote in message
...
The code below is used to select files which will then be zipped up and
saved
to a location. I am trying to automate the process completly to avoid
the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use the
Dir
command to return a list of the files just like i get inthe immediate
window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over
$1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) &
Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

The reason the API routine missed files out was that it is case sensitive.
So "*.xls" didn't find files with an extension .XLS.

RBS


"RB Smissaert" wrote in message
...
Have worked this out now and it is actually very fast and it finds some
files that the routine with
the API didn't find.
A file the API routine missed was:
C:\RBSSynergyReporting\LinkFiles\Smissaert - promote - 1599., 7E04.,
7E043, 7E045, 7E046, 7F1A0, 685H.TXT
Haven't looked yet why this would be.

As somebody might find it useful here the code:


Function FindFiles(strPath As String, _
strSearch As String, _
Optional lFileCount As Long = 0, _
Optional lDirCount As Long = 0) As String()

'adapted from the MS example:
'http://support.microsoft.com/default.aspx?scid=kb;en-us;185476
'---------------------------------------------------------------
'will list all the files in the supplied folder and it's
'subfolders that fit the strSearch criteria
'lFileCount and lDirCount will always have to start as 0
'use for example like this:
'Dim arr
'arr = FindFiles("C:\TestFolder", "*.xls")
'---------------------------------------------------------------

Dim strFileName As String 'Walking strFileName variable.
Dim strDirName As String 'SubDirectory Name.
Dim arrDirNames() As String 'Buffer for directory name entries.
Dim nDir As Integer 'Number of directories in this strPath.
Dim i As Integer 'For-loop counter.
Static strStartDirName As String
Static arrFiles

On Error GoTo sysFileERR

If Right(strPath, 1) < "\" Then
strPath = strPath & "\"
End If

If lFileCount = 0 And lDirCount = 0 Then
ReDim arrFiles(1 To 10000000) As String
strStartDirName = strPath
End If

'Search for subdirectories.
nDir = 0

ReDim arrDirNames(nDir)
strDirName = Dir(strPath, vbDirectory Or vbHidden Or vbArchive Or
vbReadOnly _
Or vbSystem) 'Even if hidden, and so
on.

Do While Len(strDirName) 0
'Ignore the current and encompassing directories.
If (strDirName < ".") And (strDirName < "..") Then
'Check for directory with bitwise comparison.
If GetAttr(strPath & strDirName) And vbDirectory Then
arrDirNames(nDir) = strDirName
lDirCount = lDirCount + 1
nDir = nDir + 1
ReDim Preserve arrDirNames(nDir)
End If 'directories.
sysFileERRCont:
End If
strDirName = Dir() 'Get next subdirectory.
Loop

'Search through this directory
strFileName = Dir(strPath & strSearch, _
vbNormal Or _
vbHidden Or _
vbSystem Or _
vbReadOnly Or _
vbArchive)

While Len(strFileName) < 0
lFileCount = lFileCount + 1
arrFiles(lFileCount) = strPath & strFileName
strFileName = Dir() 'Get next file.
Wend

'If there are sub-directories..
If nDir 0 Then
'Recursively walk into them
For i = 0 To nDir - 1
FindFiles strPath & arrDirNames(i) & "\", _
strSearch, _
lFileCount, _
lDirCount
Next
End If

'searching the supplied main directory is done last
'so that is when we redim and supply the produced array
'------------------------------------------------------
If strPath & arrDirNames(i) = strStartDirName Then
ReDim Preserve arrFiles(1 To lFileCount)
FindFiles = arrFiles
End If

AbortFunction:
Exit Function
sysFileERR:
If Right(strDirName, 4) = ".sys" Then
Resume sysFileERRCont 'Known issue with pagefile.sys
Else
MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
"Unexpected Error"
Resume AbortFunction
End If

End Function


Sub test()

Dim i As Long
Dim arr

arr = FindFiles("C:\TestFolder", "*.xls")

For i = 1 To UBound(arr)
Cells(i, 1) = arr(i)
Next

End Sub


RBS


"Tom Ogilvy" wrote in message
...
http://support.microsoft.com/default...b;en-us;185476
How To Search Directories to Find or List Files

this is a link to that article for the third method
http://support.microsoft.com/kb/185601/EN-US/
HOW TO: Recursively Search Directories by Using FileSystemObject

--
Regards,
Tom Ogilvy

"RB Smissaert" wrote in message
...
Here is some nice code from Randy Birch to do a recursive filesearch
with
the Windows API:
http://vbnet.mvps.org/index.html?cod...es_minimal.htm

RBS


"Jeff" wrote in message
...
The code below is used to select files which will then be zipped up
and
saved
to a location. I am trying to automate the process completly to avoid
the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use
the
Dir
command to return a list of the files just like i get inthe immediate
window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over
$1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) &
Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

That is an interesting tidbit.

--
Regards,
Tom Ogilvy

"RB Smissaert" wrote in message
...
The reason the API routine missed files out was that it is case sensitive.
So "*.xls" didn't find files with an extension .XLS.

RBS


"RB Smissaert" wrote in message
...
Have worked this out now and it is actually very fast and it finds some
files that the routine with
the API didn't find.
A file the API routine missed was:
C:\RBSSynergyReporting\LinkFiles\Smissaert - promote - 1599., 7E04.,
7E043, 7E045, 7E046, 7F1A0, 685H.TXT
Haven't looked yet why this would be.

As somebody might find it useful here the code:


Function FindFiles(strPath As String, _
strSearch As String, _
Optional lFileCount As Long = 0, _
Optional lDirCount As Long = 0) As String()

'adapted from the MS example:
'http://support.microsoft.com/default.aspx?scid=kb;en-us;185476
'---------------------------------------------------------------
'will list all the files in the supplied folder and it's
'subfolders that fit the strSearch criteria
'lFileCount and lDirCount will always have to start as 0
'use for example like this:
'Dim arr
'arr = FindFiles("C:\TestFolder", "*.xls")
'---------------------------------------------------------------

Dim strFileName As String 'Walking strFileName variable.
Dim strDirName As String 'SubDirectory Name.
Dim arrDirNames() As String 'Buffer for directory name
entries.
Dim nDir As Integer 'Number of directories in this strPath.
Dim i As Integer 'For-loop counter.
Static strStartDirName As String
Static arrFiles

On Error GoTo sysFileERR

If Right(strPath, 1) < "\" Then
strPath = strPath & "\"
End If

If lFileCount = 0 And lDirCount = 0 Then
ReDim arrFiles(1 To 10000000) As String
strStartDirName = strPath
End If

'Search for subdirectories.
nDir = 0

ReDim arrDirNames(nDir)
strDirName = Dir(strPath, vbDirectory Or vbHidden Or vbArchive Or
vbReadOnly _
Or vbSystem) 'Even if hidden, and so
on.

Do While Len(strDirName) 0
'Ignore the current and encompassing directories.
If (strDirName < ".") And (strDirName < "..") Then
'Check for directory with bitwise comparison.
If GetAttr(strPath & strDirName) And vbDirectory Then
arrDirNames(nDir) = strDirName
lDirCount = lDirCount + 1
nDir = nDir + 1
ReDim Preserve arrDirNames(nDir)
End If 'directories.
sysFileERRCont:
End If
strDirName = Dir() 'Get next subdirectory.
Loop

'Search through this directory
strFileName = Dir(strPath & strSearch, _
vbNormal Or _
vbHidden Or _
vbSystem Or _
vbReadOnly Or _
vbArchive)

While Len(strFileName) < 0
lFileCount = lFileCount + 1
arrFiles(lFileCount) = strPath & strFileName
strFileName = Dir() 'Get next file.
Wend

'If there are sub-directories..
If nDir 0 Then
'Recursively walk into them
For i = 0 To nDir - 1
FindFiles strPath & arrDirNames(i) & "\", _
strSearch, _
lFileCount, _
lDirCount
Next
End If

'searching the supplied main directory is done last
'so that is when we redim and supply the produced array
'------------------------------------------------------
If strPath & arrDirNames(i) = strStartDirName Then
ReDim Preserve arrFiles(1 To lFileCount)
FindFiles = arrFiles
End If

AbortFunction:
Exit Function
sysFileERR:
If Right(strDirName, 4) = ".sys" Then
Resume sysFileERRCont 'Known issue with pagefile.sys
Else
MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
"Unexpected Error"
Resume AbortFunction
End If

End Function


Sub test()

Dim i As Long
Dim arr

arr = FindFiles("C:\TestFolder", "*.xls")

For i = 1 To UBound(arr)
Cells(i, 1) = arr(i)
Next

End Sub


RBS


"Tom Ogilvy" wrote in message
...
http://support.microsoft.com/default...b;en-us;185476
How To Search Directories to Find or List Files

this is a link to that article for the third method
http://support.microsoft.com/kb/185601/EN-US/
HOW TO: Recursively Search Directories by Using FileSystemObject

--
Regards,
Tom Ogilvy

"RB Smissaert" wrote in message
...
Here is some nice code from Randy Birch to do a recursive filesearch
with
the Windows API:

http://vbnet.mvps.org/index.html?cod...es_minimal.htm

RBS


"Jeff" wrote in message
...
The code below is used to select files which will then be zipped up
and
saved
to a location. I am trying to automate the process completly to
avoid
the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use
the
Dir
command to return a list of the files just like i get inthe
immediate
window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over
$1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) &
Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr

Thanks for everyone's input! I got it to work, by passing the CORRECT
parameters, and by changing the Diretory path infortmation to include a full
path returning from the Function. ie WinZip needs to see the full path for
each file and just not for the archive

"Jeff" wrote:

The code below is used to select files which will then be zipped up and saved
to a location. I am trying to automate the process completly to avoid the
users missing files in their selection process.

Since I know that the files I want are excel, I thought I could use the Dir
command to return a list of the files just like i get inthe immediate window.

Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over $1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) & Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))

If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr