VBA listing ".xlsx" files only from a selected folder-CodePudding

I need some help with the current VBA code I am using.

The aim is first to count the .xlsx files in a folder and state the number in a defined cell, then in a table below on the same sheet, it lists files from selected folders.... Counting the files is fine but when listing .xlsx files from a selected folder it lists all the files regardless of the type...

This is currently the code I'm using, wanted to see if there is a way to list .xlsx files only?

Sub Outstanding39()

'Count files from selected folder
Dim folder_path As String
Dim strtype As String
Dim totalfiles As Variant

strtype = "*.xlsx*"

folder_path = Worksheets("Data2").Cells(83, 2).Value

If Right(folder_path, 1) <> "\" Then folder_path = folder_path & "\"
totalfiles = Dir(folder_path & strtype)

Dim i As Integer

While (totalfiles <> "")
i = i   1
totalfiles = Dir
Wend

Worksheets("Open").Cells(15, 7).Value = i
Worksheets("Open").Cells(15, 7).Select

'List Files from selected folder
Dim objFSO As Scripting.FileSystemObject
Dim objFile As Scripting.File
Dim objFolder As Scripting.Folder
Dim nextRow As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(Worksheets("Data2").Cells(83, 2).Value)

nextRow = Cells(Rows.Count, 2).End(xlUp).Row   1

For Each objFile In objFolder.Files
Cells(nextRow, 2) = objFile.Name
Cells(nextRow, 16) = objFile.ParentFolder
nextRow = nextRow   1

Next

End Sub

I am hoping someone is able to assist with doing this...

CodePudding user response：

After the line "for each" add a condition to the file extension:

For Each objFile In objFolder.Files
    If Right(objFile.Name, 4) = "xlsx" then
        Cells(nextRow, 2) = objFile.Name
        Cells(nextRow, 16) = objFile.ParentFolder
        nextRow = nextRow   1
    End If
Next

CodePudding user response：

List Files in Folder Using the FileSystemObject Object

Another way is to use the Dir function.

Sub ListFolders()
    ' VBE->Tools->References->Microsoft Scripting Runtime
   
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Build the folder path.
    Dim wsData As Worksheet: Set wsData = wb.Sheets("Data2")
    Dim pSep As String: pSep = Application.PathSeparator
    Dim FolderPath As String: FolderPath = CStr(wsData.Range("B83").Value)
    If Right(FolderPath, 1) <> pSep Then FolderPath = FolderPath & pSep
    
    ' Reference the FileSystemObject object.
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
    
    ' Check if the folder doesn't exist.
    If Not fso.FolderExists(FolderPath) Then
        MsgBox "The path '" & FolderPath & "' doesn't exist.", vbExclamation
        Exit Sub
    End If
    
    ' Reference the folder.
    Dim fsoFolder As Scripting.Folder: Set fsoFolder = fso.GetFolder(FolderPath)
    
    ' Calculate the first available row in the destination worksheet.
    Dim wsDest As Worksheet: Set wsDest = wb.Sheets("Open")
    Dim NextRow As Long
    NextRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Row   1
    
    ' Loop, check, write and count.
    
    Dim fsoFile As Scripting.File
    Dim FileExtension As String
    Dim FilesCount As Long
    
    For Each fsoFile In fsoFolder.Files
    ' If you don't want to use the 'fsoFolder' variable, you can safely use:
    'For Each fsoFile In fso.GetFolder(FolderPath).Files
        FileExtension = fso.GetExtensionName(fsoFile.Path)
        If StrComp(FileExtension, "xlsx", vbTextCompare) = 0 Then ' is a match
            wsDest.Cells(NextRow, "B").Value = fsoFile.Name
            wsDest.Cells(NextRow, "P").Value = fsoFile.ParentFolder
            FilesCount = FilesCount   1
            NextRow = NextRow   1
        'Else ' is not a match; do nothing
        End If
    Next fsoFile
    
    ' Only now write the (counted) number of files to the cell.
    wsDest.Range("G15").Value = FilesCount
    
    MsgBox "Files listed: " & FilesCount, vbInformation
    
End Sub