Manually Enter Directory Name

[Maryna]

Hi, I want to copy all the file names in a folder to a excel sheet but I only want to copy the files that end in .xlsx. I think I need to add *.xlsx* to the "Set myFolder [...]" line but I am not sure of the syntax.

This is the code that I have so far

Sub GetFilesDetails()

Dim objFSO As Scripting.FileSystemObject
Dim myFolder As Scripting.Folder
Dim myFile As Scripting.File
Dim R As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set myFolder = objFSO.GetFolder("X:\Outgoing Purchase Orders\2018\")

Application.ScreenUpdating = False


R = 2

For Each myFile In myFolder.Files

ThisWorkbook.Sheets("Sheet1").Cells(R, 1).Value = myFile.Name

ThisWorkbook.Sheets("Sheet1").Cells(R, 2).Value = myFile.DateCreated

R = R + 1

Next myFile

End Sub

Any help is much appreciated!

P.S I gave the thread the wrong name but now I can't figure out how to rename thread, or delete thread and re-do with correct title.

 

[HighAndWilder]

Hi Maryna

I've just done a bit of research and objFSO.GetExtensionName(myFile) will give you the file extension

This is a good site for this subject.

Using VBA FileSystemObject (FSO) in Excel - Easy Overview & Examples

I've added in the following line to clear the worksheet first.

ThisWorkbook.Sheets("Sheet1").Cells.Clear

Private Sub GetFilesDetails()
Dim objFSO As Scripting.FileSystemObject
Dim myFolder As Scripting.Folder
Dim myFile As Scripting.File
Dim R As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set myFolder = objFSO.GetFolder("X:\Outgoing Purchase Orders\2018\")

Application.ScreenUpdating = False

R = 2

ThisWorkbook.Sheets("Sheet1").Cells.Clear

For Each myFile In myFolder.Files

    If objFSO.GetExtensionName(myFile) = "xlsx" Then
        
        ThisWorkbook.Sheets("Sheet1").Cells(R, 1).Value = myFile.Name
        
        ThisWorkbook.Sheets("Sheet1").Cells(R, 2).Value = myFile.DateCreated
    
        ThisWorkbook.Sheets("Sheet1").Cells(R, 3).Value = objFSO.GetExtensionName(myFile)
     
        R = R + 1
    
    End If

Next myFile

Application.ScreenUpdating = True

End Sub

 

[Marc L]

Hi, a VBA demonstration for starters :​

Sub Demo1()
    Dim R&, oFile As Object
        R = 1
    With ThisWorkbook.Sheets("Sheet1")
       .[A1].CurrentRegion.Offset(R).Clear
        Application.ScreenUpdating = False
    For Each oFile In CreateObject("Scripting.FileSystemObject").GetFolder("X:\Outgoing Purchase Orders\2018\").Files
          If oFile.Name Like "*.xlsx" Then
             R = R + 1
            .Cells(R, 1).Resize(, 2).Value = Array(oFile.Name, oFile.DateCreated)
          End If
    Next
       .UsedRange.Columns.AutoFit
    End With
        Application.ScreenUpdating = True
End Sub

​

 

[Maryna]

Hi Maryna

I've just done a bit of research and objFSO.GetExtensionName(myFile) will give you the file extension

This is a good site for this subject.

Using VBA FileSystemObject (FSO) in Excel - Easy Overview & Examples

I've added in the following line to clear the worksheet first.

ThisWorkbook.Sheets("Sheet1").Cells.Clear

Private Sub GetFilesDetails()
Dim objFSO As Scripting.FileSystemObject
Dim myFolder As Scripting.Folder
Dim myFile As Scripting.File
Dim R As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set myFolder = objFSO.GetFolder("X:\Outgoing Purchase Orders\2018\")

Application.ScreenUpdating = False

R = 2

ThisWorkbook.Sheets("Sheet1").Cells.Clear

For Each myFile In myFolder.Files

    If objFSO.GetExtensionName(myFile) = "xlsx" Then
       
        ThisWorkbook.Sheets("Sheet1").Cells(R, 1).Value = myFile.Name
       
        ThisWorkbook.Sheets("Sheet1").Cells(R, 2).Value = myFile.DateCreated
   
        ThisWorkbook.Sheets("Sheet1").Cells(R, 3).Value = objFSO.GetExtensionName(myFile)
    
        R = R + 1
   
    End If

Next myFile

Application.ScreenUpdating = True

End Sub

Thank you

 

[Maryna]

Hi, a VBA demonstration for starters :​

Sub Demo1()
    Dim R&, oFile As Object
        R = 1
    With ThisWorkbook.Sheets("Sheet1")
       .[A1].CurrentRegion.Offset(R).Clear
        Application.ScreenUpdating = False
    For Each oFile In CreateObject("Scripting.FileSystemObject").GetFolder("X:\Outgoing Purchase Orders\2018\").Files
          If oFile.Name Like "*.xlsx" Then
             R = R + 1
            .Cells(R, 1).Resize(, 2).Value = Array(oFile.Name, oFile.DateCreated)
          End If
    Next
       .UsedRange.Columns.AutoFit
    End With
        Application.ScreenUpdating = True
End Sub

​

Hi, thank you. The code works