Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Is there script that will retrieve the file name of every file in a
network directory? |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Here is some code that will do what you need... The third argument is
optional to specify a file type ane the final argument is optional and specifies whether you want to search subdirectories or not... You have to reference the project to Microsoft Scripting Runtime (in the VBE select Tools - References - Microsoft Scripting Runtime ) 'Code starts here**** Option Explicit Option Compare Text Sub test() Call ListFiles("C:\", Sheet1.Range("A2"), "xls", True) End Sub Public Sub ListFiles(ByVal strPath As String, _ ByVal rngDestination As Range, Optional ByVal strFileType As String = "*", _ Optional ByVal blnSubDirectories As Boolean = False) '** Must reference Microsoft Scripting Runtime ** Dim objFSO As Scripting.FileSystemObject Dim objFolder As Scripting.Folder Dim objFile As Scripting.File Dim strName As String 'Specify the file to look for... strName = "*." & strFileType Set objFSO = New Scripting.FileSystemObject Set objFolder = objFSO.GetFolder(strPath) For Each objFile In objFolder.Files If objFile.Name Like strName Then rngDestination.Value = objFile.Path rngDestination.Offset(0, 1).Value = objFile.DateLastAccessed Set rngDestination = rngDestination.Offset(1, 0) End If Next 'objFile Set objFile = Nothing 'Call recursive function If blnSubDirectories = True Then _ DoTheSubFolders objFolder.SubFolders, rngDestination, strName Set objFSO = Nothing Set objFolder = Nothing End Sub Function DoTheSubFolders(ByRef objFolders As Scripting.Folders, _ ByRef rng As Range, ByRef strTitle As String) Dim scrFolder As Scripting.Folder Dim scrFile As Scripting.File Dim lngCnt As Long On Error GoTo ErrorHandler For Each scrFolder In objFolders For Each scrFile In scrFolder.Files If scrFile.Name Like strTitle Then rng.Value = scrFile.Path rng.Offset(0, 1).Value = scrFile.DateLastAccessed Set rng = rng.Offset(1, 0) End If Next 'scrFile 'If there are more sub folders then go back and run function again. If scrFolder.SubFolders.Count 0 Then DoTheSubFolders scrFolder.SubFolders, rng, strTitle End If ErrorHandler: Next 'scrFolder Set scrFile = Nothing Set scrFolder = Nothing End Function -- HTH... Jim Thomlinson "James D Smooth" wrote: Is there script that will retrieve the file name of every file in a network directory? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
produce a formulate to produce assigned seats for dinner | Excel Worksheet Functions | |||
Move all files from one directory to another | Excel Programming | |||
Files in a directory? | Excel Discussion (Misc queries) | |||
Check if directory empty OR no of files in directory. | Excel Programming | |||
run macro for all files in the directory | Excel Programming |