none
VBA to display all unspecified files RRS feed

  • Question

  • Hi there,

    I'm relatively new to vba and here for advice/suggestions.

    With below code (pieces of which i had taken from various places on google), I managed to get the hyperlinks to the files in all sub folders that meet the conditions ("IF" statements), and display them in the specified cells. Yay!

    The thing is that a sub folder may have files that do not meet the conditions, but i still want to get their names and display them in the "OTHER #" columns. 

    For example, SUB FOLDER 2 may have 5 files. I got 3 of them displayed in cells C6, I6 and J6.
    How do I get the remaining 2 files into cells K6 and L6?

    Hope i'm making sense.

    Any suggestions, I'd love to hear and learn!

    Thank you!

    Jay

    --------------------------------------------------------------------------------------------------                   

    Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)

    Application.ScreenUpdating = False

    Dim xFileSystemObject As Object
    Dim xFolder As Object
    'Dim xSubFolder As Object
    Dim xFile As Object
    Dim rowIndex As Long

    Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFileSystemObject.GetFolder(xFolderName)

    rowIndex = Cells(Rows.Count, 1).End(xlUp).Row + 1

    For Each xFile In xFolder.Files

        Cells(rowIndex, 1) = Split(xFile.Path, "\")(6)
        Cells(rowIndex, 2) = xFolder.Name

        If InStr(1, xFile.Name, "cue") > 0 Then Cells(rowIndex, 3) = "=HYPERLINK(""" & xFile.Path & """,""" & "open" & """)"
        If InStr(1, xFile.Name, "dpl") > 0 Then Cells(rowIndex, 4) = "=HYPERLINK(""" & xFile.Path & """,""" & "open" & """)"
        If Left(xFile.Name, 5) = "daily" Then Cells(rowIndex, 5) = "=HYPERLINK(""" & xFile.Path & """,""" & "open" & """)"
        If InStr(1, xFile.Name, "dve") > 0 Then Cells(rowIndex, 6) = "=HYPERLINK(""" & xFile.Path & """,""" & "open" & """)"
        If Left(xFile.Name, 5) = "log" Then Cells(rowIndex, 7) = "=HYPERLINK(""" & xFile.Path & """,""" & "open" & """)"
        If Left(xFile.Name, 5) = "media" Then Cells(rowIndex, 8) = "=HYPERLINK(""" & xFile.Path & """,""" & "open" & """)"
        If Left(xFile.Name, 4) = "Spot" Then Cells(rowIndex, 9) = "=HYPERLINK(""" & xFile.Path & """,""" & "open" & """)"
        If Left(xFile.Name, 2) = "tx" Then Cells(rowIndex, 10) = "=HYPERLINK(""" & xFile.Path & """,""" & "open" & """)"


    Next xFile

    If xIsSubfolders Then
      For Each xSubFolder In xFolder.SubFolders
        ListFilesInFolder xSubFolder.Path, True
      Next xSubFolder

      rowIndex = rowIndex + 1
    End If

    Application.ScreenUpdating = True

    End Sub

    --------------------------------------------------------------------------------------------------                   

    Tuesday, February 11, 2020 9:36 AM

Answers

  • Try this version:

    Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
        Dim xFileSystemObject As Object
        Dim xFolder As Object
        Dim xSubFolder As Object
        Dim xFile As Object
        Dim rowIndex As Long
        Dim colIndex As Long
        Dim otherCol As Long
        Application.ScreenUpdating = False
        Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
        Set xFolder = xFileSystemObject.GetFolder(xFolderName)
        rowIndex = Cells(Rows.Count, 1).End(xlUp).Row + 1
        otherCol = 11
        For Each xFile In xFolder.Files
            Cells(rowIndex, 1) = Split(xFile.Path, "\")(6)
            Cells(rowIndex, 2) = xFolder.Name
            If InStr(1, xFile.Name, "cue") > 0 Then
                colIndex = 3
            ElseIf InStr(1, xFile.Name, "dpl") > 0 Then
                colIndex = 4
            ElseIf Left(xFile.Name, 5) = "daily" Then
                colIndex = 5
            ElseIf InStr(1, xFile.Name, "dve") > 0 Then
                colIndex = 6
            ElseIf Left(xFile.Name, 5) = "log" Then
                colIndex = 7
            ElseIf Left(xFile.Name, 5) = "media" Then
                colIndex = 8
            ElseIf Left(xFile.Name, 4) = "Spot" Then
                colIndex = 9
            ElseIf Left(xFile.Name, 2) = "tx" Then
                colIndex = 10
            Else
                colIndex = otherCol
                otherCol = otherCol + 1
            End If
            Cells(rowIndex, colIndex).Formula = "=HYPERLINK(""" & xFile.Path & """,""" & "open" & """)"
        Next xFile
        If xIsSubfolders Then
            For Each xSubFolder In xFolder.SubFolders
                ListFilesInFolder xSubFolder.Path, True
            Next xSubFolder
            rowIndex = rowIndex + 1
        End If
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by jay.nz Tuesday, February 11, 2020 8:15 PM
    Tuesday, February 11, 2020 12:56 PM

All replies

  • Try this version:

    Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
        Dim xFileSystemObject As Object
        Dim xFolder As Object
        Dim xSubFolder As Object
        Dim xFile As Object
        Dim rowIndex As Long
        Dim colIndex As Long
        Dim otherCol As Long
        Application.ScreenUpdating = False
        Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
        Set xFolder = xFileSystemObject.GetFolder(xFolderName)
        rowIndex = Cells(Rows.Count, 1).End(xlUp).Row + 1
        otherCol = 11
        For Each xFile In xFolder.Files
            Cells(rowIndex, 1) = Split(xFile.Path, "\")(6)
            Cells(rowIndex, 2) = xFolder.Name
            If InStr(1, xFile.Name, "cue") > 0 Then
                colIndex = 3
            ElseIf InStr(1, xFile.Name, "dpl") > 0 Then
                colIndex = 4
            ElseIf Left(xFile.Name, 5) = "daily" Then
                colIndex = 5
            ElseIf InStr(1, xFile.Name, "dve") > 0 Then
                colIndex = 6
            ElseIf Left(xFile.Name, 5) = "log" Then
                colIndex = 7
            ElseIf Left(xFile.Name, 5) = "media" Then
                colIndex = 8
            ElseIf Left(xFile.Name, 4) = "Spot" Then
                colIndex = 9
            ElseIf Left(xFile.Name, 2) = "tx" Then
                colIndex = 10
            Else
                colIndex = otherCol
                otherCol = otherCol + 1
            End If
            Cells(rowIndex, colIndex).Formula = "=HYPERLINK(""" & xFile.Path & """,""" & "open" & """)"
        Next xFile
        If xIsSubfolders Then
            For Each xSubFolder In xFolder.SubFolders
                ListFilesInFolder xSubFolder.Path, True
            Next xSubFolder
            rowIndex = rowIndex + 1
        End If
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by jay.nz Tuesday, February 11, 2020 8:15 PM
    Tuesday, February 11, 2020 12:56 PM
  • It works! 

    Thank you very much Hans!!

    Just one question to help me better understand vba.

    I noticed that you had changed my multiple IF statements to ElseIf ones. Why was this necessary? I've always been unsure as to when i should use ElseIf, because If and ElseIf seem to give me the same result...

    Tuesday, February 11, 2020 8:26 PM
  • 1) With multiple If's, VBA will execute ALL of them.

    With an If ... ElseIf ... ElseIf ... Else ... End If construct, VBA will jump to the instruction after End If the moment one of the conditions has been met and the corresponding instructions have been executed. So it is more efficient.

    Also, we only need to assign the column number in this construct. There is a single line after it that sets the HYPERLINK formula.

    2) You wanted to do something with files that do not meet ANY of the conditions. The final Else in the If ... ElseIf ... ElseIf ... Else ... End If construct lets us do that.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Tuesday, February 11, 2020 8:37 PM
  • Oh i see. That's probably why your code runs faster than mine. 

    Superb! Thank you very much Hans!

    Tuesday, February 11, 2020 10:26 PM