Listing All Files in Folder and Cell Values in Files

[sukyb1]

I have the code below....at the moment it works but i need to amend it so that it doesnt open each file within the directory to extract the information out of the cells. Please can someone help to change is so that the workbooks stayed closed whilst reading data from them
Thanks...

Dim iRow
Dim Counter
Dim A1Value As String
Dim B7Value As String
Dim B11Value As String
Dim B14Value As String
Dim B15Value As String
Dim B17Value As String
Dim K55Value As String
Dim myFile As Scripting.File
Sub ListFiles()
On Error Resume Next
Call Setup
Call ListMyFiles(Range("Folder"), Range("Include_Subfolders"))
Call SortRange
Call HideUnwantedCols
' Call DisplayOrder
Call RefreshPivot
End Sub

Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Dim MyObject As Scripting.FileSystemObject

On Error Resume Next
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)

For Each myFile In mySource.Files
Counter = 1
For i = 1 To 11
Call GetAttribute(i)
Next

If UCase(Right(myFile.Name, 4)) = ".XLS" Or UCase(Right(myFile.Name, 4)) = "XLSX" Then

Cells(iRow, Counter).Value = GetFooter()
Cells(iRow, Counter + 1).Value = A1Value
Cells(iRow, Counter + 2).Value = B7Value
Cells(iRow, Counter + 3).Value = B11Value
Cells(iRow, Counter + 4).Value = B14Value
Cells(iRow, Counter + 5).Value = B15Value
Cells(iRow, Counter + 6).Value = B17Value
Cells(iRow, Counter + 7).Value = K55Value

End If

If iRow > Range("Stop_After") Then Exit Sub
Application.StatusBar = "File Number: " & iRow
iRow = iRow + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True)
Next
End If
End Sub
Sub Setup()
Sheets("Files").Select
Cells.ClearContents
Cells.EntireColumn.Hidden = False
iCol = 1
iRow = 2
Cells(1, iCol) = "Attributes"
iCol = iCol + 1
Cells(1, iCol) = "DateCreated"
iCol = iCol + 1
Cells(1, iCol) = "DateLastAccessed"
iCol = iCol + 1
Cells(1, iCol) = "DateLastModified"
iCol = iCol + 1
Cells(1, iCol) = "Drive"
iCol = iCol + 1
Cells(1, iCol) = "Name"
iCol = iCol + 1
Cells(1, iCol) = "ParentFolder"
iCol = iCol + 1
Cells(1, iCol) = "Path"
iCol = iCol + 1
Cells(1, iCol) = "ShortName"
iCol = iCol + 1
Cells(1, iCol) = "Size"
iCol = iCol + 1
Cells(1, iCol) = "Type"
iCol = iCol + 1
Cells(1, iCol) = "Footer"
iCol = iCol + 1
Cells(1, iCol) = "A1 Value"
iCol = iCol + 1
Cells(1, iCol) = "Issued Date"
iCol = iCol + 1
Cells(1, iCol) = "Territory"
iCol = iCol + 1
Cells(1, iCol) = "Project Name"
iCol = iCol + 1
Cells(1, iCol) = "Location"
iCol = iCol + 1
Cells(1, iCol) = "OP Number"
iCol = iCol + 1
Cells(1, iCol) = "Total (AFC)"

For iCol = 1 To 11
Columns(iCol).NumberFormat = Range("Format").Offset(iCol).NumberFormat
Next
End Sub
Function GetAttribute(AttributeNumber)
If Range("What_To_Show").Offset(Counter, 0).Font.Bold = True Then
Select Case AttributeNumber
Case 1
Cells(iRow, Counter).Value = myFile.Attributes
Case 2
Cells(iRow, Counter).Value = myFile.DateCreated
Case 3
Cells(iRow, Counter).Value = myFile.DateLastAccessed
Case 4
Cells(iRow, Counter).Value = myFile.DateLastModified
Case 5
Cells(iRow, Counter).Value = myFile.Drive
Case 6
Cells(iRow, Counter).Value = myFile.Name
Case 7
Cells(iRow, Counter).Value = myFile.ParentFolder
Case 8
Cells(iRow, Counter).Value = myFile.Path
Case 9
Cells(iRow, Counter).Value = myFile.ShortName
Case 10
Cells(iRow, Counter).Value = myFile.Size
Case 11
Cells(iRow, Counter).Value = myFile.Type
End Select
End If
Counter = Counter + 1
End Function
Private Function GetFooter() As String
Dim wBook As Workbook
Set wBook = Workbooks.Open(myFile.Path)

Dim sSheet As Worksheet
Set sSheet = wBook.Sheets(1)

With sSheet
GetFooter = ""
A1Value = .Cells(1, 1).Value
B7Value = .Cells(7, 2).Value
B11Value = .Cells(11, 2).Value
B14Value = .Cells(14, 2).Value
B15Value = .Cells(15, 2).Value
B17Value = .Cells(17, 2).Value
K55Value = .Cells(55, 11).Value

End With

wBook.Close (False)
Set wBook = Nothing
End Function
Sub SortRange()
With ActiveWorkbook.Worksheets("Files").Sort
.SortFields.Clear
For i = 1 To 11
Set rngFoundIt = Sheets("Main").Columns(Range("Sort_Order").Column).Find(i, LookIn:=xlValues, LookAt:=xlWhole)
If Not rngFoundIt Is Nothing Then
.SortFields.Add Key:=Cells(2, rngFoundIt.Row - Range("Sort_Order").Row), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End If
Next
.SetRange Range("A1").CurrentRegion
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Cells.EntireColumn.AutoFit
End Sub
Sub HideUnwantedCols()
For i = 1 To 11
If Range("What_To_Show").Offset(i, 0).Font.Bold = False Then
Sheets("files").Columns(i).Hidden = True
End If
Next
End Sub
Sub RefreshPivot()
Sheets("pivot").Select
ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
End Sub

 

[cgcamal]

Hi sukyb1,

I'm not an expert in this issue, but I share with you below links related with what you want.

To read a few data from closed workbooks:
- Read information from a closed workbook using VBA in Microsoft Excel

To read a lot of data from closed workbooks is advisible using ADO:
- Import data from a closed workbook (ADO) using VBA in Microsoft Excel

Hope this helps,

Regards.