Assuming that all of the problems I found in the code were caused by posting here and you don't have them, the code seems to work fine to me.
I would move the I = I + 1 statement to inside the previous If … End If block, so as to avoid lots of blank lines.
From: ExcelVBA@yahoogroups.com [mailto:ExcelVBA@yahoogroups.com]
Sent: 15 July 2017 16:03
To: ExcelVBA@yahoogroups.com
Subject: [ExcelVBA] File Finder
Hi, Need your advise and help on this.
I'm using couple of codes including the one below. This code helps in extracting files that were updated beyond a date.
I need your assistance in applying a small change that will only extract files if a folder/subfoIder/and further down was updated beyond a date. It is only when the macro will get in that folder and extract those files.
Currently, if folder A has a subfolder B and within B there is subfoIder C. If a excel file was updated in subfolder C then folder C will also show the same last modified date, while the folder A and B will not. By doing this the macro will only enter that folder which shows last modified date or in case if the user defined date is any day prior to the aforesaid modified date.
My hunch is that at present the macro is going through each folder and scanning through each file hence taking a lot of time..
Thanks in advance for help here.
Sub Start()
Dim FiIeSystem As Object
Dim HostFolder As String
HostFolder = "\\c: drive"
Set FileSystem= CreateObject ("Scripting.FileSystemObject")
DoFolder FileSystem.GetFoIder(HostFolder)
End Sub
Sub DoFolder(Folder)
Dim SubFoIder
For Each SubFoIder In Folder.SubFolders DoFolder SubFoIder
Next
Dim cutoffDate As Date
cutoffDate = (ActiveSheet.Cells(1, 2).Value)
i = Cells(Rows.Count, 1).End(xlUp).Row+ 1
Dim File
For Each File In Folder.Files
If FileDateTime(File.Path) > cutoffDate Then ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:= _
File.Path, TextToDisplay:=File.Name ActiveSheet.Cells(i, 2).Value = FileDateTime(File.Path)
End If
i + 1
Next
Columns.AutoFit
End Sub
Posted by: "Bob Phillips" <bob.phillips@dsl.pipex.com>
Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (5) |
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com
----------------------------------
Tidak ada komentar:
Posting Komentar