Solved

Bold Enumerated Folders, Rename Sheet

Posted on 2012-04-13
3
220 Views
Last Modified: 2012-04-16
I'm using the following code to list items within a particular folder or subfolder.  What I would like to do, is Bold the Folders that are enumerated while leaving the files normal, to easily see what is a document or not.

The second thing is to rename the sheet with the actual subdirectory Name only, instead of the path that is being enumerated?  Or, Maybe there is an easier way to manage all of the code documents that have been collected over the years.

Sub GetFileNames()
Dim iRow As Integer
Dim strDirectory As String, strFName As String, strInitialFoldr As String

iRow = 1
Range("A1").Activate
     With Application.FileDialog(msoFileDialogFolderPicker)
           .Show
           strDirectory = .SelectedItems(1) & "\"
             strInitialFoldr = strDirectory
      End With

     With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Now….Please select a  *Folder*  to list Files from"
         .InitialFileName = strInitialFoldr
       .Show
             If .SelectedItems.Count <> 0 Then
                 strDirectory = .SelectedItems(1) & "\"
                  strFName = Dir(strDirectory, 16)
                          Do While strFName <> ""
                            ActiveCell.Offset(iRow) = strFName
                            iRow = iRow + 1
                            strFName = Dir
                         Loop
      Range("A1") = strDirectory
      ActiveWindow.DisplayGridlines = False
      Range("A1").EntireColumn.AutoFit
  End If
 End With
End Sub

Open in new window

0
Comment
Question by:Cook09
  • 2
3 Comments
 
LVL 81

Expert Comment

by:byundt
ID: 37845059
If I understand you correctly, the following tweaks to your code will make the folder name bold, with the file names in Roman. I also eliminated the . and .. at the top of the list.
Sub GetFileNames()
Dim iRow As Integer
Dim strDirectory As String, strFName As String, strInitialFoldr As String

iRow = 1
Range("A1").Activate
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    strDirectory = .SelectedItems(1) & "\"
    strInitialFoldr = strDirectory
End With

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Now….Please select a  *Folder*  to list Files from"
    .InitialFileName = strInitialFoldr
    .Show
     If .SelectedItems.Count <> 0 Then
        strDirectory = .SelectedItems(1) & "\"
        strFName = Dir(strDirectory, 16)
        Do While strFName <> ""
            Select Case strFName
            Case ".", ".."
            Case Else
                ActiveCell.Offset(iRow) = strFName
                iRow = iRow + 1
            End Select
            strFName = Dir
        Loop
        strDirectory = Left(strDirectory, Len(strDirectory) - 1)
        Range("A1") = Mid(strDirectory, InStrRev(strDirectory, Application.PathSeparator) + 1)
        Range("A1").Font.Bold = True
        ActiveWindow.DisplayGridlines = False
        Range("A1").EntireColumn.AutoFit
    End If
End With
End Sub

Open in new window


Brad
0
 
LVL 81

Accepted Solution

by:
byundt earned 500 total points
ID: 37845091
If you also want to rename the worksheet with the main folder name and bold any subfolders found, then here is the macro with those additional tweaks:

Sub GetFileNames()
Dim iRow As Integer
Dim strDirectory As String, strFName As String, strInitialFoldr As String

iRow = 1
Range("A1").Activate
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    strDirectory = .SelectedItems(1) & "\"
    strInitialFoldr = strDirectory
End With

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Now….Please select a  *Folder*  to list Files from"
    .InitialFileName = strInitialFoldr
    .Show
     If .SelectedItems.Count <> 0 Then
        strDirectory = .SelectedItems(1) & "\"
        strFName = Dir(strDirectory, 16)
        Do While strFName <> ""
            Select Case strFName
            Case ".", ".."
            Case Else
                ActiveCell.Offset(iRow) = strFName
                    'Test whether strFName is subfolder or file
                On Error Resume Next
                If GetAttr(strDirectory & strFName) = vbDirectory Then ActiveCell.Offset(iRow).Font.Bold = True
                On Error GoTo 0
                iRow = iRow + 1
            End Select
            strFName = Dir
        Loop
        strDirectory = Left(strDirectory, Len(strDirectory) - 1)
        strDirectory = Mid(strDirectory, InStrRev(strDirectory, Application.PathSeparator) + 1)
        Range("A1").Value = strDirectory
        Range("A1").Font.Bold = True
        ActiveSheet.Name = strDirectory
        ActiveWindow.DisplayGridlines = False
        Range("A1").EntireColumn.AutoFit
    End If
End With
End Sub

Open in new window


Brad
0
 

Author Closing Comment

by:Cook09
ID: 37851108
Exactly what I wanted with this question.  Thanks Brad.  I do have one more item to add to this code, but I'll post it as a seperate question, as it may require a little more thought.
0

Featured Post

The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft Office Picture Manager was included in Office 2003, 2007, and 2010, but not in Office 2013. Users had hopes that it would be in Office 2016/Office 365, but it is not. Fortunately, the same zero-cost technique that works to install it with …
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question