VBA; how to extract all files names from a folder - without using Application.FileDialog object

Question

As in the Question: the task is to extract all files names from a folder, but the folder path needs to be hard coded into the macro, to prevent these dialog boxes asking me things and wasting my time. I will not change this folder. It will be the same one until the end of time, and I want to extract the files names into the Excel column, starting from second row. this is the folder I want to extract ALL files names from. "C:\\Users\\michal\\SkyDrive\\csv\\bossa\\mstcgl_mst\\"

this is my portion of code:

Option Explicit
Sub GetFileNames()
Dim axRow As Long          ' inside the Sheet("Lista") row#
Dim xDirectory As String   
Dim xFname As String       ' name of the file    
Dim InitialFoldr$        
Dim start As Double
Dim finish As Double
Dim total_time As Double

start = Timer
ThisWorkbook.Sheets("Lista").Range("D2").Activate
  InitialFolder = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst"
  If Right(InitialFolder, 1) <> "\" Then
     InitialFolder = InitialFolder & "\"
  End If

  Application.InitialFolder.Show

    If InitialFolder.SelectedItems.Count <> 0 Then    
       xDirectory = .SelectedItems(1) & "\"  
         xFname = Dir(xDirectory, vbArchive)   
          ' Dir's job is to return a string representing
          ' the name of a file, directory, or an archive that matches a specified pattern.
            Do While xFname <> ""   ' there is already xFname value (1st file name) assigned.
               ActiveCell.Offset(xRow) = xFname                                        
               xRow = xRow + 1    ' następny xRow
               xFname = Dir()    
            Loop                  
   End If
 End With

 finish = Timer                              ' Set end time.
 total_time = Round(finish - start, 3)       ' Calculate total time.
 MsgBox "This code ran successfully in " & total_time & " seconds", vbInformation

End Sub

this is the line that crushes: If InitialFolder.SelectedItems.Count <> 0 Then xDirectory = .SelectedItems(1) & "\\"

And two more important questions in the .png file. Please, respond to them as well - it's very important 4 me.

Or if U guys know any other method to do this faster just don't hesitate and share Your Code with me - I'll be very grateful.

Answer 1

See example below

Public Sub Listpng()
Const strFolder As String = "C:\SomeFolder\"
Const strPattern As String = "*.png"
Dim strFile As String
strFile = Dir(strFolder & strPattern, vbNormal)
Do While Len(strFile) > 0
Debug.Print strFile '<- view this in Immediate window; Ctrl+g will take you there
strFile = Dir
Loop
End Sub

Answer 2

Sub Files()
Dim sht As Worksheet
Dim strDirectory As String, strFile As String
Dim i As Integer: i = 1

Set sht = Worksheets("Sheet1")
strDirectory = "C:\Users\User\Desktop\"
strFile = Dir(strDirectory, vbNormal)

Do While strFile <> ""
    With sht
        .Cells(i, 1) = strFile
        .Cells(i, 2) = strDirectory + strFile
    End With
    'returns the next file or directory in the path
    strFile = Dir()
    i = i + 1
Loop
End Sub

Answer 3

There's a couple of procedures I use depending on whether I want subfolders as well.

This loops through the folder and adds path & name to a collection:

Sub Test1()
    Dim colFiles As Collection
    Dim itm As Variant

    Set colFiles = New Collection

    EnumerateFiles "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\", "*.xls*", colFiles

    For Each itm In colFiles
        Debug.Print itm
    Next itm
End Sub

Sub EnumerateFiles(ByVal sDirectory As String, _
    ByVal sFileSpec As String, _
    ByRef cCollection As Collection)

    Dim sTemp As String

    sTemp = Dir$(sDirectory & sFileSpec)
    Do While Len(sTemp) > 0
        cCollection.Add sDirectory & sTemp
        sTemp = Dir$
    Loop
End Sub

This second way goes through the subfolders as well returning path & name. For some reason if you change InclSubFolders to False it only returns the name - got to sort that bit out.

Sub Test2()
    Dim vFiles As Variant
    Dim itm As Variant

    vFiles = EnumerateFiles_2("C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\", "xls*")

    For Each itm In vFiles
        Debug.Print itm
    Next itm
End Sub

Public Function EnumerateFiles_2(sDirectory As String, _
            Optional sFileSpec As String = "*", _
            Optional InclSubFolders As Boolean = True) As Variant

    EnumerateFiles_2 = Filter(Split(CreateObject("WScript.Shell").Exec _
        ("CMD /C DIR """ & sDirectory & "*." & sFileSpec & """ " & _
        IIf(InclSubFolders, "/S ", "") & "/B /A:-D").StdOut.ReadAll, vbCrLf), ".")

End Function