Could someone please tell me what this vba code is doing? Especially the top
part ... where it says; Dim fso f ... Thanks.

Sub LoopThroughFolder()
Dim fso, f, fldnm As String, WB As Workbook, WS As Worksheet, r As Long
Dim ws2 As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")

fldnm = "C:\Documents and Settings\moyea0\My Documents\And\10K\2005\Data"
'Folder to loop through
Set WS = Workbooks("10K_DataEntry.xls").Sheets("Data")

r = WS.Cells.Find(What:="*", LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
Application.ScreenUpdating = False
For Each f In fso.GetFolder(fldnm).Files
If UCase(Right(f.Name, 3)) = "XLS" Then
Set WB = Workbooks.Open(f.Path)
Set ws2 = WB.Sheets("WOR Summary")
With WS.Rows(r)
.Columns("J") = ws2.Range("C2").Value
.Columns("L") = ws2.Range("C4").Value
.Columns("M") = ws2.Range("C7").Value
.Columns("N") = ws2.Range("C9").Value
.Columns("O") = ws2.Range("F2").Value
.Columns("P") = ws2.Range("F3").Value
.Columns("Q") = ws2.Range("F4").Value
.Columns("R") = ws2.Range("F5").Value
.Columns("S") = ws2.Range("F6").Value
.Columns("T") = ws2.Range("F7").Value
.Columns("U") = ws2.Range("F8").Value
.Columns("V") = ws2.Range("F9").Value
.Columns("W") = ws2.Range("F10").Value
.Columns("X:BG") = Application.Transpose(ws2.Range("F13:F48").Value)
.Columns("BH") = ws2.Range("F50").Value
.Columns("BI:BN") = Application.Transpose(ws2.Range("F54:F59").Value)
End With
r = r + 1
WB.SaveAs fldnm & "\archive1\" & f.Name
WB.Close
f.Delete
End If
Next
Application.ScreenUpdating = True
End Sub

The Dim are dimension statements delcaring placeholders for various values
or objects that the program code uses or requires.
A declaration with a qualifier eg Dim f creates a variant type, others using
a declaration with 'As' such as WS As Worksheet is just that.
Later on the WS is set to point to an object in this case a worksheet, which
is then referred to as WS.


--
Cheers
Nigel



"inspirz" wrote in message
...
Could someone please tell me what this vba code is doing? Especially the
top
part ... where it says; Dim fso f ... Thanks.

Sub LoopThroughFolder()
Dim fso, f, fldnm As String, WB As Workbook, WS As Worksheet, r As Long
Dim ws2 As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")

fldnm = "C:\Documents and Settings\moyea0\My Documents\And\10K\2005\Data"
'Folder to loop through
Set WS = Workbooks("10K_DataEntry.xls").Sheets("Data")

r = WS.Cells.Find(What:="*", LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
Application.ScreenUpdating = False
For Each f In fso.GetFolder(fldnm).Files
If UCase(Right(f.Name, 3)) = "XLS" Then
Set WB = Workbooks.Open(f.Path)
Set ws2 = WB.Sheets("WOR Summary")
With WS.Rows(r)
.Columns("J") = ws2.Range("C2").Value
.Columns("L") = ws2.Range("C4").Value
.Columns("M") = ws2.Range("C7").Value
.Columns("N") = ws2.Range("C9").Value
.Columns("O") = ws2.Range("F2").Value
.Columns("P") = ws2.Range("F3").Value
.Columns("Q") = ws2.Range("F4").Value
.Columns("R") = ws2.Range("F5").Value
.Columns("S") = ws2.Range("F6").Value
.Columns("T") = ws2.Range("F7").Value
.Columns("U") = ws2.Range("F8").Value
.Columns("V") = ws2.Range("F9").Value
.Columns("W") = ws2.Range("F10").Value
.Columns("X:BG") = Application.Transpose(ws2.Range("F13:F48").Value)
.Columns("BH") = ws2.Range("F50").Value
.Columns("BI:BN") = Application.Transpose(ws2.Range("F54:F59").Value)
End With
r = r + 1
WB.SaveAs fldnm & "\archive1\" & f.Name
WB.Close
f.Delete
End If
Next
Application.ScreenUpdating = True
End Sub

fso and f are both variants in this case (Rather poor programming form in my
opinion. They should be objects.). They are being used as file system
objects. They allow you to access files and folders. Look up file system
objects and the microsoft scripting runtime library in the help menu for more
info.
--
HTH...

Jim Thomlinson


"inspirz" wrote:

Could someone please tell me what this vba code is doing? Especially the top
part ... where it says; Dim fso f ... Thanks.

Sub LoopThroughFolder()
Dim fso, f, fldnm As String, WB As Workbook, WS As Worksheet, r As Long
Dim ws2 As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")

fldnm = "C:\Documents and Settings\moyea0\My Documents\And\10K\2005\Data"
'Folder to loop through
Set WS = Workbooks("10K_DataEntry.xls").Sheets("Data")

r = WS.Cells.Find(What:="*", LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
Application.ScreenUpdating = False
For Each f In fso.GetFolder(fldnm).Files
If UCase(Right(f.Name, 3)) = "XLS" Then
Set WB = Workbooks.Open(f.Path)
Set ws2 = WB.Sheets("WOR Summary")
With WS.Rows(r)
.Columns("J") = ws2.Range("C2").Value
.Columns("L") = ws2.Range("C4").Value
.Columns("M") = ws2.Range("C7").Value
.Columns("N") = ws2.Range("C9").Value
.Columns("O") = ws2.Range("F2").Value
.Columns("P") = ws2.Range("F3").Value
.Columns("Q") = ws2.Range("F4").Value
.Columns("R") = ws2.Range("F5").Value
.Columns("S") = ws2.Range("F6").Value
.Columns("T") = ws2.Range("F7").Value
.Columns("U") = ws2.Range("F8").Value
.Columns("V") = ws2.Range("F9").Value
.Columns("W") = ws2.Range("F10").Value
.Columns("X:BG") = Application.Transpose(ws2.Range("F13:F48").Value)
.Columns("BH") = ws2.Range("F50").Value
.Columns("BI:BN") = Application.Transpose(ws2.Range("F54:F59").Value)
End With
r = r + 1
WB.SaveAs fldnm & "\archive1\" & f.Name
WB.Close
f.Delete
End If
Next
Application.ScreenUpdating = True
End Sub

See my notes in the code:
Sub LoopThroughFolder()
Dim fso, f, fldnm As String, WB As Workbook, WS As Worksheet, r As Long
Dim ws2 As Worksheet
' ALL THE ABOVE ARE SETTING UP THE VARIABLES USED BY THE CODE AND DEFINING
THEIR TYPES: fso AND f HAVE NO DEFINED TYPES SO THEY ARE VARIANT
Set fso = CreateObject("Scripting.FileSystemObject")
' MAKES fso INTO A FileSystemObject OBJECT - THIS IS USED TO READ THE FILE
SYSTEM - I.E. TO LOOP THROUGH THE FOLDER IN THIS CASE

fldnm = "C:\Documents and Settings\moyea0\My Documents\And\10K\2005\Data"
'Folder to loop through
Set WS = Workbooks("10K_DataEntry.xls").Sheets("Data")
- WS IS NOW THE "Data" WORKSHEET IN THE OPEN WORKBOOK NAMED "10K_DataEntry"

r = WS.Cells.Find(What:="*", LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
r IS FINDING THE LAST USED ROW ON THE WORKSHEET WS
Application.ScreenUpdating = False
TURN OFF SCREEN UPDATES TO SAVE TIME AND/OR AVOID SCREEN 'FLICKER'
For Each f In fso.GetFolder(fldnm).Files
f WILL LOOP THROUGH ALL FILES (of any type) IN THE FOLDER SPECIFIED ABOVE
If UCase(Right(f.Name, 3)) = "XLS" Then
THIS DETECTS IF IT IS AN EXCEL (.xls) FILE
Set WB = Workbooks.Open(f.Path)
IF SO, OPEN THAT WORKBOOK AND CALL IT WB
Set ws2 = WB.Sheets("WOR Summary")
ws2 IS NOW THE "WOR Summary" SHEET IN THE NEWLY OPENED BOOK
With WS.Rows(r)
USING THE CURRENTLY SPECIFIED ROW r ON THE ORIGINAL SHEET WS, SET THE VALUES
IN THE COLUMNS SPECIFIED BELOW EQUAL TO THE VALUES READ FROM THE NEWLY OPENED
BOOK WB SHEET ws2:
.Columns("J") = ws2.Range("C2").Value
.Columns("L") = ws2.Range("C4").Value
.Columns("M") = ws2.Range("C7").Value
.Columns("N") = ws2.Range("C9").Value
.Columns("O") = ws2.Range("F2").Value
.Columns("P") = ws2.Range("F3").Value
.Columns("Q") = ws2.Range("F4").Value
.Columns("R") = ws2.Range("F5").Value
.Columns("S") = ws2.Range("F6").Value
.Columns("T") = ws2.Range("F7").Value
.Columns("U") = ws2.Range("F8").Value
.Columns("V") = ws2.Range("F9").Value
.Columns("W") = ws2.Range("F10").Value
.Columns("X:BG") = Application.Transpose(ws2.Range("F13:F48").Value)
THE LINE ABOVE SETS THE COLUMNS X THROUGH BG (IN THE ORIGINAL WS) INTO THE
TRANSPOSED RANGE F13:F48 FROM ws2 (transposed=make the column into a row)
.Columns("BH") = ws2.Range("F50").Value
.Columns("BI:BN") = Application.Transpose(ws2.Range("F54:F59").Value)
THIS IS SIMILAR TO THE OTHER TRANSPOSE, ABOVE
End With
DONE NOW WITH THAT ROW (r)
r = r + 1
MOVES TO NEXT ROW IN WS
WB.SaveAs fldnm & "\archive1\" & f.Name
SAVES THE BOOK WB INTO THE \archive1\ FOLDER
WB.Close
CLOSES BOOK WB
f.Delete
DELETES THE ORIGINAL FILE THAT CONTAINED WB
End If
Next
MOVES ON TO THE NEXT FILE IN THE FOLDER
Application.ScreenUpdating = True
SCREEN UPDATING IS BACK ON
End Sub
--
- K Dales


"inspirz" wrote:

Could someone please tell me what this vba code is doing? Especially the top
part ... where it says; Dim fso f ... Thanks.

Sub LoopThroughFolder()
Dim fso, f, fldnm As String, WB As Workbook, WS As Worksheet, r As Long
Dim ws2 As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")

fldnm = "C:\Documents and Settings\moyea0\My Documents\And\10K\2005\Data"
'Folder to loop through
Set WS = Workbooks("10K_DataEntry.xls").Sheets("Data")

r = WS.Cells.Find(What:="*", LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
Application.ScreenUpdating = False
For Each f In fso.GetFolder(fldnm).Files
If UCase(Right(f.Name, 3)) = "XLS" Then
Set WB = Workbooks.Open(f.Path)
Set ws2 = WB.Sheets("WOR Summary")
With WS.Rows(r)
.Columns("J") = ws2.Range("C2").Value
.Columns("L") = ws2.Range("C4").Value
.Columns("M") = ws2.Range("C7").Value
.Columns("N") = ws2.Range("C9").Value
.Columns("O") = ws2.Range("F2").Value
.Columns("P") = ws2.Range("F3").Value
.Columns("Q") = ws2.Range("F4").Value
.Columns("R") = ws2.Range("F5").Value
.Columns("S") = ws2.Range("F6").Value
.Columns("T") = ws2.Range("F7").Value
.Columns("U") = ws2.Range("F8").Value
.Columns("V") = ws2.Range("F9").Value
.Columns("W") = ws2.Range("F10").Value
.Columns("X:BG") = Application.Transpose(ws2.Range("F13:F48").Value)
.Columns("BH") = ws2.Range("F50").Value
.Columns("BI:BN") = Application.Transpose(ws2.Range("F54:F59").Value)
End With
r = r + 1
WB.SaveAs fldnm & "\archive1\" & f.Name
WB.Close
f.Delete
End If
Next
Application.ScreenUpdating = True
End Sub

The bits on the Dims have been answered, but the code basically finds the
end of the data, then reads a lot of files, dropping data from them into the
next free row, then updating that row count.

--

HTH

RP
(remove nothere from the email address if mailing direct)


"inspirz" wrote in message
...
Could someone please tell me what this vba code is doing? Especially the
top
part ... where it says; Dim fso f ... Thanks.

Sub LoopThroughFolder()
Dim fso, f, fldnm As String, WB As Workbook, WS As Worksheet, r As Long
Dim ws2 As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")

fldnm = "C:\Documents and Settings\moyea0\My Documents\And\10K\2005\Data"
'Folder to loop through
Set WS = Workbooks("10K_DataEntry.xls").Sheets("Data")

r = WS.Cells.Find(What:="*", LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
Application.ScreenUpdating = False
For Each f In fso.GetFolder(fldnm).Files
If UCase(Right(f.Name, 3)) = "XLS" Then
Set WB = Workbooks.Open(f.Path)
Set ws2 = WB.Sheets("WOR Summary")
With WS.Rows(r)
.Columns("J") = ws2.Range("C2").Value
.Columns("L") = ws2.Range("C4").Value
.Columns("M") = ws2.Range("C7").Value
.Columns("N") = ws2.Range("C9").Value
.Columns("O") = ws2.Range("F2").Value
.Columns("P") = ws2.Range("F3").Value
.Columns("Q") = ws2.Range("F4").Value
.Columns("R") = ws2.Range("F5").Value
.Columns("S") = ws2.Range("F6").Value
.Columns("T") = ws2.Range("F7").Value
.Columns("U") = ws2.Range("F8").Value
.Columns("V") = ws2.Range("F9").Value
.Columns("W") = ws2.Range("F10").Value
.Columns("X:BG") = Application.Transpose(ws2.Range("F13:F48").Value)
.Columns("BH") = ws2.Range("F50").Value
.Columns("BI:BN") = Application.Transpose(ws2.Range("F54:F59").Value)
End With
r = r + 1
WB.SaveAs fldnm & "\archive1\" & f.Name
WB.Close
f.Delete
End If
Next
Application.ScreenUpdating = True
End Sub