Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Open Files Macro
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? |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Open Files Macro
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" wrote in message ... 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? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
open files run macro | Excel Discussion (Misc queries) | |||
macro to open in all files | Excel Programming | |||
macro open files | Excel Programming | |||
Macro Open Files | Excel Programming | |||
Macro to open *.dat files and save as .txt (comma delimited text files) | Excel Programming |