Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
list directory in EXCEL
Does this help-
Option Explicit Private cnt As Long Private arfiles Private level As Long Sub Folders() Dim i As Long Dim sFolder As String Dim iStart As Long Dim iEnd As Long Dim fOutline As Boolean arfiles = Array() cnt = -1 level = 1 sFolder = "C:\MyTest" ReDim arfiles(2, 0) If sFolder < "" Then SelectFiles sFolder Application.DisplayAlerts = False On Error Resume Next Worksheets("Files").Delete On Error GoTo 0 Application.DisplayAlerts = True Worksheets.Add.Name = "Files" With ActiveSheet For i = LBound(arfiles, 2) To UBound(arfiles, 2) If arfiles(0, i) = "" Then If fOutline Then Rows(iStart + 1 & ":" & iEnd).Rows.Group End If With .Cells(i + 1, arfiles(2, i)) .Value = arfiles(1, i) .Font.Bold = True End With iStart = i + 1 iEnd = iStart fOutline = False Else .Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _ Address:=arfiles(0, i), _ TextToDisplay:=arfiles(1, i) iEnd = iEnd + 1 fOutline = True End If Next .Columns("A:Z").ColumnWidth = 5 End With End If 'just in case there is another set to group If fOutline Then Rows(iStart + 1 & ":" & iEnd).Rows.Group End If Columns("A:Z").ColumnWidth = 5 ActiveSheet.Outline.ShowLevels RowLevels:=1 ActiveWindow.DisplayGridlines = False End Sub '----------------------------------------------------------------------- Sub SelectFiles(Optional sPath As String) '----------------------------------------------------------------------- Static FSO As Object Dim oSubFolder As Object Dim oFolder As Object Dim oFile As Object Dim oFiles As Object Dim arPath If FSO Is Nothing Then Set FSO = CreateObject("SCripting.FileSystemObject") End If If sPath = "" Then sPath = CurDir End If arPath = Split(sPath, "\") cnt = cnt + 1 ReDim Preserve arfiles(2, cnt) arfiles(0, cnt) = "" arfiles(1, cnt) = arPath(level - 1) arfiles(2, cnt) = level Set oFolder = FSO.GetFolder(sPath) Set oFiles = oFolder.Files For Each oFile In oFiles If oFile.Type = "Adobe Acrobat Document" Then cnt = cnt + 1 ReDim Preserve arfiles(2, cnt) arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name arfiles(1, cnt) = oFile.Name arfiles(2, cnt) = level + 1 End If Next oFile level = level + 1 For Each oSubFolder In oFolder.SubFolders SelectFiles oSubFolder.Path Next level = level - 1 End Sub #If VBA6 Then #Else '-----------------------------**-----------------------------*-*------ Function Split(Text As String, _ Optional Delimiter As String = ",") As Variant '-----------------------------**-----------------------------*-*------ Dim i As Long Dim sFormula As String Dim aryEval Dim aryValues If Delimiter = vbNullChar Then Delimiter = Chr(7) Text = Replace(Text, vbNullChar, Delimiter) End If sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") & """}" aryEval = Evaluate(sFormula) ReDim aryValues(0 To UBound(aryEval) - 1) For i = 0 To UBound(aryValues) aryValues(i) = aryEval(i + 1) Next Split = aryValues End Function #End If -- HTH RP "Marina Limeira" wrote in message ... as to make in VBA in excel: How to place each name of file inside of a folder in each cell an archive name, where has a column with the listing of all the names of files in determined folder? thanks Marina |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
list directory in EXCEL
as to make in VBA in excel:
How to place each name of file inside of a folder in each cell an archive name, where has a column with the listing of all the names of files in determined folder? thanks Marina |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Address List in Excel | Excel Discussion (Misc queries) | |||
Data Val list Excel 97 fire macro | Excel Discussion (Misc queries) | |||
Get excel to list values that occur within raw data | Excel Discussion (Misc queries) | |||
Slow opening directory structure in Excel 2002 | Excel Discussion (Misc queries) | |||
Excel List range, filter arrows disappeared | Excel Discussion (Misc queries) |