link all workbooks to a index page
 

i have approx 100 workbooks in a folder which contain data on individual staff

i would like to be able to have a "index" page which reads all the
information from all the other workbooks in rows

in the data workbooks the info is always in the same place,

is this possible in vba

link all workbooks to a index page
 

I have adapted some code from others (sorry I did not note their
names):
Option Explicit
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private FSO As Object
Private c As Long
Private ar

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim sh As Worksheet
Set FSO = CreateObject("Scripting.FileSystemObject")
ar = Array()
c = -1
sFolder = GetFolder
ReDim ar(1, 0)
If sFolder < "" Then
SelectFiles sFolder
On Error Resume Next
Set sh = Worksheets("Files")
On Error GoTo 0
If Not sh Is Nothing Then
sh.Cells.ClearContents
Else
Worksheets.Add.Name = "Files"
End If
Range("A1").Select
ActiveCell.FormulaR1C1 = "Path"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Excel Files"
Range("A1:B1").Select
Selection.Font.Bold = True
With ActiveSheet
For i = LBound(ar, 2) To UBound(ar, 2)
Cells(i + 2, 1) = ar(0, i)
Cells(i + 2, 2) = ar(1, i)
Next
..Columns("A:B").EntireColumn.AutoFit
End With
End If
End Sub

Sub SelectFiles(Optional Pth As String)
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
If Pth = "" Then
Set FSO = CreateObject("Scripting.FileSystemObject")
Pth = GetFolder
End If
Set Folder = FSO.GetFolder(Pth)
Set Files = Folder.Files
For Each file In Files
If Right(file.Name, 3) = "xls" Then
c = c + 1
ReDim Preserve ar(1, c)
ar(0, c) = Folder.path & "\"
ar(1, c) = file.Name
End If
Next file
For Each fldr In Folder.Subfolders
SelectFiles fldr.path
Next
End Sub

Function GetFolder(Optional ByVal Name As String = _
"Select a folder.") As String
Dim BI As BROWSEINFO
Dim path As String
Dim oDialog As Long
BI.pidlRoot = 0&
BI.lpszTitle = Name
BI.ulFlags = &H1
oDialog = SHBrowseForFolder(BI)
path = Space$(512)
GetFolder = ""
If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
End If
End Function


--
raypayette


------------------------------------------------------------------------
raypayette's Profile: http://www.excelforum.com/member.php...o&userid=29569
View this thread: http://www.excelforum.com/showthread...hreadid=561945