Open Files Macro

[JZ]

I am trying to write a macro that will open all the files sequentially in a
folder. For example, I have a folder with 30 files, and I want them to be
opened one after another. However, I do not want the specific filename to be
designated in the macro. Rather, I would like something that will simply
open the next file in the folder so that I can run the macro for multiple
folders. Does anyone have any suggestions?

[RB Smissaert]

Use this general purpose function that will put all the files in a folder
(and optionally all the subfolders) in an array.
By looping through the array you can open all the files.


Option Explicit
Private Const lSheetRows As Long = 65536

Function RecursiveFindFiles(strPath As String, _
strSearch As String, _
Optional bSubFolders As Boolean = True, _
Optional bSheet As Boolean = False, _
Optional lFileCount As Long = 0, _
Optional lDirCount As Long = 0) As Variant

'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
'---------------------------------------------------------------

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 Long 'Number of directories in this strPath.
Dim i As Long 'For-loop counter.
Dim n As Long
Dim arrFiles
Static strStartDirName As String
Static strpathOld As String

On Error GoTo sysFileERR

If lFileCount = 0 Then
Static collFiles As Collection
Set collFiles = New Collection
Application.Cursor = xlWait
End If

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

If lFileCount = 0 And lDirCount = 0 Then
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
DoEvents
ReDim Preserve arrDirNames(nDir)
End If 'directories.
sysFileERRCont1:
End If
strDirName = Dir() 'Get next subdirectory

DoEvents
Loop

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

While Len(strFileName) <> 0

'dump file in sheet
'------------------
If bSheet Then
If lFileCount < lSheetRows Then
Cells(lFileCount + 1, 1) = strPath & strFileName
End If
End If

lFileCount = lFileCount + 1

collFiles.Add strPath & strFileName

If strPath <> strpathOld Then
Application.StatusBar = " " & lFileCount & _
" " & strSearch & " files found. " & _
"Now searching " & strPath
End If

strpathOld = strPath

strFileName = Dir() 'Get next file

DoEvents
Wend

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

DoEvents
Next
End If 'If nDir > 0

'only bare main folder left, so get out
'--------------------------------------
If strPath & arrDirNames(i) = strStartDirName Then
ReDim arrFiles(1 To lFileCount) As String
For n = 1 To lFileCount
arrFiles(n) = collFiles(n)
Next
RecursiveFindFiles = arrFiles
Application.Cursor = xlDefault
Application.StatusBar = False
End If

Else 'If bSubFolders
ReDim arrFiles(1 To lFileCount) As String
For n = 1 To lFileCount
arrFiles(n) = collFiles(n)
Next
RecursiveFindFiles = arrFiles
Application.Cursor = xlDefault
Application.StatusBar = False
End If 'If bSubFolders

Exit Function
sysFileERR:

Resume sysFileERRCont1

End Function


Sub Test()

Dim arr
Dim lDirCount As Long
Dim lFileCount As Long

arr = RecursiveFindFiles("C:\", _
"*.*", _
False, _
True, _
lFileCount, _
lDirCount)

MsgBox lFileCount & " files found"

End Sub


RBS


"JZ" <[email protected]> wrote in message
news:[email protected]...
>I am trying to write a macro that will open all the files sequentially in a
> folder. For example, I have a folder with 30 files, and I want them to be
> opened one after another. However, I do not want the specific filename to
> be
> designated in the macro. Rather, I would like something that will simply
> open the next file in the folder so that I can run the macro for multiple
> folders. Does anyone have any suggestions?