CODEWITHSUNDEEP
listvbadirectory
Ollie
Ollie

Reputation: 13

How to open a specific folder to list files within

I am new to VBA and am struggling to get an Excel sheet to do what i want, any help would be much appreciated.

I am building an excel sheet that will import the file name and attributes of files in a specific folder. I have butchered several other examples of VBA code i have found online and have most of it sorted (hence why most of the code isn't needed but i have left it for reference), the file name is imported alongside the attributes i want displayed.

The problems i have is that i cant seem to get it to open a specific folder each time the code runs, it just defaults to the My Documents folder (ideally i would like it to look at a Network Share but I'm not sure if that is possible)

Also it is listing every file in the folder structure when i manually select a folder and i just want the contents of that folder but i can pick that up after getting this first (hopefully easy) step sorted.

Thanks for any suggestions

Sub ListFiles()
' Workbooks.Add
' create a new workbook for the file list

' add headers
'Clear out existing data
    ActiveWindow.Panes(1).Activate
    Range("B9:D50").Select
    Selection.ClearContents

'Set column headers
'With Range("A8")
    '.Font.Bold = True
    '.Font.Size = 10
'End With
'Range("A8").Formula = "File Name:"
'Range("B8").Formula = "Path:"
'Range("C8").Formula = "File Size:"
'Range("D8").Formula = "Date Created:"
'Range("E8").Formula = "Date Last Modified:"
'Range("F8").Formula = "Owner:"
    Range("B9:I9").Font.Bold = False
    Range("B10:I50").Font.Bold = False

'Add comments
    'Range("A1").Select
    'Selection.ClearComments
    'Range("N1").AddComment
    'Range("N1").Comment.Visible = False
    'Range("N1").Comment.Text Text:="ZZZZZZZZZ" & Chr(10) & "ZZZZZZZ"
    'Range("N1").Select

 ' Prompt user for destination file name.
   Application.FileDialog(msoFileDialogFolderPicker).Show
    MyPath = CurDir + "\"
ListFilesInFolder MyPath, True


End Sub


Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
  Dim FSO As Object
  Dim SourceFolder As Object
  Dim SubFolder As Object
  Dim FileItem As Object
  Dim r As Long

     Set FSO = CreateObject("Scripting.FileSystemObject")
     Set SourceFolder = FSO.GetFolder(SourceFolderName)

       r = Range("B65536").End(xlUp).Row + 1
       For Each FileItem In SourceFolder.Files
        'display file properties
         Cells(r, 2).Formula = FileItem.Name
         'Cells(r, 2).Formula = FileItem.Path
         'Cells(r, 3).Formula = FileItem.Size
         Cells(r, 3).Formula = FileItem.DateCreated
         Cells(r, 4).Formula = FileItem.DateLastModified
         'Cells(r, 6).Formula = GetFileOwner(SourceFolder.Path, FileItem.Name)
         r = r + 1 ' next row number
         x = SourceFolder.Path
       Next FileItem

       If IncludeSubfolders Then
         For Each SubFolder In SourceFolder.SubFolders
           ListFilesInFolder SubFolder.Path, False
         Next SubFolder
       End If

    'Columns("A:G").AutoFit
    'Columns("H:I").AutoFit
    'Columns("J:L").AutoFit
    'Columns("M:P").AutoFit

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing

    ActiveWorkbook.Saved = False

End Sub


Function GetFileOwner(ByVal FilePath As String, ByVal FileName As String)

  Dim objFolder As Object
  Dim objFolderItem As Object
  Dim objShell As Object

    FileName = StrConv(FileName, vbUnicode)
    FilePath = StrConv(FilePath, vbUnicode)

     Set objShell = CreateObject("Shell.Application")
     Set objFolder = objShell.Namespace(StrConv(FilePath, vbFromUnicode))

       If Not objFolder Is Nothing Then
         Set objFolderItem = objFolder.ParseName(StrConv(FileName, vbFromUnicode))
       End If

       If Not objFolderItem Is Nothing Then
         GetFileOwner = objFolder.GetDetailsOf(objFolderItem, 8)
       Else
         GetFileOwner = ""
       End If

     Set objShell = Nothing
     Set objFolder = Nothing
     Set objFolderItem = Nothing

End Function

Upvotes: 1

Views: 919

Answers (1)

ssarabando
ssarabando

Reputation: 3517

You have to set InitialFileName before calling Show:

Sub ListFiles()
    ' etc
    With Application.FileDialog(msoFileDialogFolderPicker)
        ' Notice the slash at the end
        .InitialFileName = "\\server\share\folder\"
        ' Disable multiple selections since it seems you would want that
        .AllowMultiSelect = False
        If .Show = -1 Then
            ' Since user didn't cancel and multiple selections are disabled,
            ' there will be only one selected item
            MyPath = .SelectedItems(1)
            ' Call your code here
            ListFilesInfolder MyPath, True
        End If
End With

End Sub

Here is the link to the relevant documentation on MSDN.

Upvotes: 1

Related Questions