Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find New File/Folder
Okay,
I need to write a macro that will find the most recently created folder within a given folder. I will then need to search that folder for any files (.xls) that are not currently linked to the workbook in which the macro is contained. I need to return the filename and location for use in another macro. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find New File/Folder
This should give you a start anyways. This code MUST be referenced to
"microsoft Scripting Runtime" (Tools - References -...) Option Explicit Option Compare Text Sub test() Call ListFiles("C:\", Sheet1.Range("A2"), "xls", True) 'Change the directory End Sub Public Sub ListFiles(ByVal strPath As String, _ ByVal rngDestination As Range, Optional ByVal strFileType As String = "*", _ Optional ByVal blnSubDirectories As Boolean = False) 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 "BOONER" wrote: Okay, I need to write a macro that will find the most recently created folder within a given folder. I will then need to search that folder for any files (.xls) that are not currently linked to the workbook in which the macro is contained. I need to return the filename and location for use in another macro. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find New File/Folder
Cool,
Although it took me a while to achieve my goal; your help definately made it all possible. Thanks! "Jim Thomlinson" wrote: This should give you a start anyways. This code MUST be referenced to "microsoft Scripting Runtime" (Tools - References -...) Option Explicit Option Compare Text Sub test() Call ListFiles("C:\", Sheet1.Range("A2"), "xls", True) 'Change the directory End Sub Public Sub ListFiles(ByVal strPath As String, _ ByVal rngDestination As Range, Optional ByVal strFileType As String = "*", _ Optional ByVal blnSubDirectories As Boolean = False) 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 "BOONER" wrote: Okay, I need to write a macro that will find the most recently created folder within a given folder. I will then need to search that folder for any files (.xls) that are not currently linked to the workbook in which the macro is contained. I need to return the filename and location for use in another macro. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Need code to save file to new folder, erase from old folder | Excel Discussion (Misc queries) | |||
Find Folder Path + file Name Length and Insert into Spreadsheet | Excel Programming | |||
open file from folder save in new folder | Excel Programming | |||
What is folder OLK7 and where can I find it? | Excel Discussion (Misc queries) | |||
Create Folder and Text File in folder | Excel Programming |