MrExcel Publishing
Your One Stop for Excel Tips & Solutions

get dir list or open files sequentialy


Posted by John on January 24, 2002 10:18 AM

I would like to open files in a specific directory one at a time, strip the data and then close and move the file to another directory. Is there a way to do this. If not is there a way to do this how can I make a list of files in a directory?

Thanks,

John


Posted by Bariloche on January 24, 2002 7:31 PM

John,

This subroutine, modified to your specifics, should get you going:


Dim File() As String
Dim FoundFile As String
Dim FileCount As Integer
Dim strDataBookName As String
Dim strConsolidatedBook As String
Dim intLastRow As Double
Dim strTemp As String

Sub ConsolidateData()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

FoundFile = Dir("C:\MyDocuments\*.xls")

FileCount = 1
ReDim Preserve File(FileCount)
File(FileCount) = FoundFile

Do While FoundFile <> ""
FoundFile = Dir()
If FoundFile <> "" Then
FileCount = FileCount + 1
ReDim Preserve File(FileCount)
File(FileCount) = FoundFile
End If
Loop

ChDir "C:\MyDocuments\"
Workbooks.Open File(1)
strDataBookName = ActiveWorkbook.Name
Workbooks.Add
strConsolidatedBook = ActiveWorkbook.Name
Workbooks(strDataBookName).Sheets("Sheet1").Range(Cells(1, 1), Cells(9, 32)).Copy
Workbooks(strConsolidatedBook).Paste
Application.CutCopyMode = False
Rows(9).Hidden = True
intLastRow = Workbooks(strDataBookName).Sheets("Sheet1").Cells(65536, 2).End(xlUp).Row
Workbooks(strDataBookName).Sheets("Sheet1").Range(Cells(1, 10), Cells(intLastRow, 32)).Copy

For i = 2 To FileCount
Workbooks.Open File(i)
strTemp = ActiveWorkbook.Name
Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Copy
Workbooks(strDataBookName).Activate
Cells(i, 2).PasteSpecial Paste:=xlValues, Transpose:=True
Application.CutCopyMode = False
Workbooks(strTemp).Close
Cells(i, 1).Value = Left(File(i), Len(File(i)) - 4)
Next i

Cells(1, 1).Select
Application.Dialogs(xlDialogSaveAs).Show

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


have fun