Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Uisng the Max and Index function to link to other workbooks | Excel Discussion (Misc queries) | |||
if i sort cell that has link to another page how to keep link | Excel Discussion (Misc queries) | |||
if i sort cell that has link to another page how to keep link | Excel Discussion (Misc queries) | |||
set up a link that updates page one from all other page entries? | Excel Worksheet Functions | |||
INDEX and workbooks | Excel Worksheet Functions |