PDA

View Full Version : Solved: Cycling through multiple files in a directory



ranuse
11-02-2010, 11:30 AM
Hi,

I'm trying to figure out how to write code that will check a specified directory for all excel files starting with "Project" in their file name. If the project workbooks are found, the macro should open each workbook, one at a time, and compare cell A1 of that workbook with cell C1 of the orginal workbook (the workbook that contains the macro).
Cells A1 and C1 should be in date format (e.g., 11/01/10) and the comparision should check if A1 is less than C1.

If true, copy A1 into a temporary variable stored in the original workbook and close project workbook. If false, do nothing and go to next workbook wih "Project" in file name. Loop until all files with "Project" in name have been checked.

Thanks very much for your help and time.

Blade Hunter
11-02-2010, 03:18 PM
Maybe this??


Sub CycleDir()
Dim MyDir As String
Dim MyFile As String
Dim MyDate As Date
Dim TempValue as Date
MyDir = "C:\" 'Make sure the \ is on the end
MyFile = Dir(MyDir & "Project*.xl*")
MyDate = Range("C1").Value
Do While MyFile <> ""
Workbooks.Open MyFile
If Range("A1").Value < MyDate Then
TempValue = Range("A1").Value
ActiveSheet.Close False
Range("D" & Range("D" & Rows.Count).End(xlUp).Row + 1).Formula = TempValue
MyFile = Dir
Loop
End Sub


It will output to column D, you can change this to whatever you want.

mdmackillop
11-02-2010, 03:40 PM
Option Explicit

Sub Test()
Dim Pth As String
Dim FName As String
Dim Dte As Date
Dim Dte2 As Date
Dim Dts()
Dim i As Long


Dte = Sheets(1).Cells(1, 3)
Pth = "C:\AAA\"
FName = Dir(Pth & "Project*.xlsx")

Application.ScreenUpdating = False
ReDim Dts(1)
Do Until FName = ""
Dte2 = NewDate(FName)
If Dte2 < Dte Then
Dts(i) = Dte2
i = i + 1
ReDim Preserve Dts(i)
Cells(i + 1, 1) = Dts(i - 1)
End If
FName = Dir
Loop
ReDim Preserve Dts(i - 1)
Application.ScreenUpdating = True

End Sub

Function NewDate(fil As String) As Date
Dim WB As Workbook
Set WB = Workbooks.Open(fil)
NewDate = WB.Sheets(1).Cells(1, 1)
WB.Close False
End Function

ranuse
11-02-2010, 04:26 PM
Thanks for the reply. I tested your code out and initially I received an error stating that there's a loop without do. I added and end if statement before loop and it fixed the error, but now when I run the macro an error stating that "Project 1.xlsx" could not be found. I am certain that the directory contains a file called "Project 1.xlsx".

mdmackillop
11-02-2010, 04:43 PM
My mistake, you did say XLS. Change this line to omit the final x
FName = Dir(Pth & "Project*.xls")