Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Looping thru Files In FolderSub
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 430
Default Looping thru Files In FolderSub
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

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default Looping thru Files In FolderSub
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

"Jim May" wrote:

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


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 430
Default Looping thru Files In FolderSub
Thanks Tom;
I'll read through..
Jim

"Tom Ogilvy" wrote in message
:

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

"Jim May" wrote:


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



Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 477
Default Looping thru Files In FolderSub
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

"Tom Ogilvy" wrote:

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

"Jim May" wrote:

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


Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27,285
Default Looping thru Files In FolderSub
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

--
Regards,
Tom Ogilvy

"Jim May" wrote in message
...
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

"Tom Ogilvy" wrote:

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

"Jim May" wrote:

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




Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Looping through excel files to add to a new workbook Geoff Excel Programming 8 April 29th 06 11:54 AM
Looping through files in a folder prepotency[_12_] Excel Programming 1 July 13th 05 04:23 PM
Looping thru files extracting data gtslabs[_2_] Excel Programming 3 June 3rd 05 04:22 PM
Looping thru files Tom Excel Programming 4 January 9th 04 05:05 PM
looping to create multiple files jrh Excel Programming 1 July 23rd 03 07:09 PM


All times are GMT +1. The time now is 12:34 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement