Looping thru Files In FolderSub

J

Jim May

I see my error, but don't know how to fix it.
Can someone assist?
TIA

Sub ExtractDataFromFiles()
Const sPath = "C:\Documents and Settings\Test\"
Dim sName As String
Dim wb As Workbook
Dim j As Integer
Dim n As Integer
Dim r(1 To 14) As Variant
' Load UserForm1
' UserForm1.Show False 'Your Macro is Running
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
sName = Dir(sPath & "*.xls")
j = 6 ' Data starts on Row 6
Do While sName <> ""
sName = Dir(sPath & "*.xls") <<<<<<<< File Name Not Changing
because of Line 12
Set wb = Workbooks.Open(sPath & sName)
With wb.Worksheets("Cost Analysis")
r(1) = .Range("J2").Value
r(2) = .Range("B4").Value
r(3) = .Range("B6").Value
r(4) = .Range("G4").Value
r(5) = .Range("G6").Value
r(6) = .Range("G6").Value
r(7) = .Range("J1").Value
r(8) = .Range("G51").Value
r(9) = .Range("G53").Value
r(10) = .Range("G54").Value
r(11) = .Range("G56").Value
r(12) = .Range("G57").Value
r(13) = .Range("G58").Value
r(14) = .Range("G59").Value
End With
wb.Close SaveChanges:=False
With ThisWorkbook.ActiveSheet
For n = 1 To 14
.Cells(j, n).Value = r(n)
Next n
End With
j = j + 1
'End If
'Set wb = Nothing
Loop
End Sub
 
T

Tom Ogilvy

It is usually done like this. Subsequent calls to Dir have no argument. by
putting in an argument, you are starting back over at the first file.

Sub ExtractDataFromFiles()
Const sPath = "C:\Documents and Settings\Test\"
Dim sName As String
Dim wb As Workbook
Dim j As Integer
Dim n As Integer
Dim r(1 To 14) As Variant
' Load UserForm1
' UserForm1.Show False 'Your Macro is Running
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
sName = Dir(sPath & "*.xls")
j = 6 ' Data starts on Row 6
Do While sName <> ""
Set wb = Workbooks.Open(sPath & sName)
With wb.Worksheets("Cost Analysis")
r(1) = .Range("J2").Value
r(2) = .Range("B4").Value
r(3) = .Range("B6").Value
r(4) = .Range("G4").Value
r(5) = .Range("G6").Value
r(6) = .Range("G6").Value
r(7) = .Range("J1").Value
r(8) = .Range("G51").Value
r(9) = .Range("G53").Value
r(10) = .Range("G54").Value
r(11) = .Range("G56").Value
r(12) = .Range("G57").Value
r(13) = .Range("G58").Value
r(14) = .Range("G59").Value
End With
wb.Close SaveChanges:=False
With ThisWorkbook.ActiveSheet
For n = 1 To 14
.Cells(j, n).Value = r(n)
Next n
End With
j = j + 1
'End If
'Set wb = Nothing
'
' added line
'
sName = Dir
Loop
End Sub
 
J

Jim May

Thanks Tom;
I'll read through..
Jim

It is usually done like this. Subsequent calls to Dir have no argument. by
putting in an argument, you are starting back over at the first file.

Sub ExtractDataFromFiles()
Const sPath = "C:\Documents and Settings\Test\"
Dim sName As String
Dim wb As Workbook
Dim j As Integer
Dim n As Integer
Dim r(1 To 14) As Variant
' Load UserForm1
' UserForm1.Show False 'Your Macro is Running
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
sName = Dir(sPath & "*.xls")
j = 6 ' Data starts on Row 6
Do While sName <> ""
Set wb = Workbooks.Open(sPath & sName)
With wb.Worksheets("Cost Analysis")
r(1) = .Range("J2").Value
r(2) = .Range("B4").Value
r(3) = .Range("B6").Value
r(4) = .Range("G4").Value
r(5) = .Range("G6").Value
r(6) = .Range("G6").Value
r(7) = .Range("J1").Value
r(8) = .Range("G51").Value
r(9) = .Range("G53").Value
r(10) = .Range("G54").Value
r(11) = .Range("G56").Value
r(12) = .Range("G57").Value
r(13) = .Range("G58").Value
r(14) = .Range("G59").Value
End With
wb.Close SaveChanges:=False
With ThisWorkbook.ActiveSheet
For n = 1 To 14
.Cells(j, n).Value = r(n)
Next n
End With
j = j + 1
'End If
'Set wb = Nothing
'
' added line
'
sName = Dir
Loop
End Sub

--
Regards,
Tom Ogilvy

:
 
J

Jim May

If I wished to qualify the *.xls that are opened/considered to only be
files which start with the same two letters "PA", (meaning
I want only files such as PA05Abc-1.xls; PA06123.xls; PA 057122-BB.xls)..
how would I do that?
Tks,
Jim
 
T

Tom Ogilvy

Sub abc()
cnt = 0
sName = Dir("E:\Data\PA*.xls")
Do While sName <> ""
cnt = cnt + 1
Debug.Print sName
sName = Dir
Loop
Debug.Print cnt
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top