Re: [ExcelVBA] File Finder

 

Thanks Bob!

Lisa ( Group Moderator )

-----Original Message-----
From: 'Bob Phillips' bob.phillips@dsl.pipex.com [ExcelVBA] <ExcelVBA@yahoogroups.com>
To: ExcelVBA <ExcelVBA@yahoogroups.com>
Sent: Thu, Jul 20, 2017 5:38 pm
Subject: RE: [ExcelVBA] File Finder

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: Green <1z@compuserve.com>

---

Reply via web post

•

Reply to sender

•

Reply to group

•

Start a New Topic

•

Messages in this topic (6)

---

Have you tried the highest rated email app?

With 4.5 stars in iTunes, the Yahoo Mail app is the highest rated email app on the market. What are you waiting for? Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.

---

----------------------------------
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

----------------------------------

Visit Your Group

• Privacy • Unsubscribe • Terms of Use

.

__,_._,___