+ Reply to Thread
Results 1 to 2 of 2

Create list from directories

  1. #1
    SoloGIS
    Guest

    Create list from directories

    I've got a number of pdf's located in seperate folders. The pdf filename is a
    number representing a coding structure. I want to generate a list in Excel of
    all the pdf's. Can anyone guide me how to do this?

  2. #2
    Bob Phillips
    Guest

    Re: Create list from directories

    Here is one way

    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

    '---------------------------------------------------------------------------
    Public Function InStrRev(stringcheck As String, _
    ByVal stringmatch As String, _
    Optional ByVal start As Long = -1)
    '---------------------------------------------------------------------------
    Dim iStart As Long
    Dim iLen As Long
    Dim i As Long

    If iStart = -1 Then
    iStart = Len(stringcheck)
    Else
    iStart = start
    End If

    iLen = Len(stringmatch)

    For i = iStart To 1 Step -1
    If Mid(stringcheck, i, iLen) = stringmatch Then
    InStrRev = i
    Exit Function
    End If
    Next i
    InStrRev = 0
    End Function
    '-----------------------------------------------------------------
    #End If



    --

    HTH

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


    "SoloGIS" <[email protected]> wrote in message
    news:[email protected]...
    > I've got a number of pdf's located in seperate folders. The pdf filename

    is a
    > number representing a coding structure. I want to generate a list in Excel

    of
    > all the pdf's. Can anyone guide me how to do this?




+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1