macro adjustment

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

driller - 24 May 2008 10:23 GMT

Dear All,

i have this basic macro provide by forum member that can do a lot of work.
but due to more demands, i like that this macro can be separately operated
made for each sheets in one workbook.
In a way that when i place in A1 the text for Target Directory, the macro
will react and give result on the opened sheet starting from Row 2.
Same will go for other sheets in one workbook. I have 50 Folders that
contains a 100 different files, and these files are oftenly increased,
replaced or deleted.
Thats why I need this Macro very badly to produce a working comparative
workbook in a weekly bloody basis.

here below is the nice macro

Sub getdates()
Folder = "D:\My Documents\FOLDER-1"
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set Folder = _
fso.GetFolder(Folder)

RowNumber = 1
'folder size in bytes
On Error GoTo 200
For Each fl In Folder.Files
Sheets(1).Cells(RowNumber, "C") = fl.DateLastModified
Sheets(1).Cells(RowNumber, "B") = fl.Size
Sheets(1).Cells(RowNumber, "A") = strFolder & fl.Name
RowNumber = RowNumber + 1
Next fl

200 On Error GoTo 0

Im not good in reading between the lines of this language...please help.
Thanks in advance.

Signature

best regards,

Reply to this Message

Joel - 24 May 2008 10:33 GMT

I think you just want to change sheet1 to the activesheet

Sub getdates1()
folder = "D:\My Documents\FOLDER-1"
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(folder)

RowNumber = 1
'folder size in bytes
On Error GoTo 200
For Each fl In folder.files
ActiveSheet.Cells(RowNumber, "C") = fl.DateLastModified
ActiveSheet.Cells(RowNumber, "B") = fl.Size
ActiveSheet.Cells(RowNumber, "A") = strFolder & fl.name
RowNumber = RowNumber + 1
Next fl

200 On Error GoTo 0
End Sub

> Dear All,
>
[quoted text clipped - 33 lines]
> Im not good in reading between the lines of this language...please help.
> Thanks in advance.

Reply to this Message

driller - 24 May 2008 10:47 GMT

You are really helpful, thanks for the very quick feedback.
I really dont know how to make the macro auto-read the text in A1 of the
active sheet which will contain the folder's directory while the result will
be outlined from Row 2.

thanks for your effort.

Signature

regards,

> I think you just want to change sheet1 to the activesheet
>
[quoted text clipped - 56 lines]
> > Im not good in reading between the lines of this language...please help.
> > Thanks in advance.

Reply to this Message

Mike H - 24 May 2008 10:45 GMT

Hi,

To make it work for any sheet with a director in a1 try this. Alt+F11 to
open VB editor. Double click 'This workbook' and paste this in. Enter a valid
dirextory into A1 for the listing

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Range("A1").Value = "" Then Exit Sub
Application.EnableEvents = False
Folder = Range("A1").Value
On Error GoTo 200
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set Folder = fso.GetFolder(Folder)

RowNumber = 2
'folder size in bytes
On Error GoTo 200
For Each fl In Folder.Files
ActiveSheet.Cells(RowNumber, "C") = fl.DateLastModified
ActiveSheet.Cells(RowNumber, "B") = fl.Size
ActiveSheet.Cells(RowNumber, "A") = strFolder & fl.Name
RowNumber = RowNumber + 1
Next fl

200 On Error GoTo 0
Application.EnableEvents = True
End Sub

Mike

> Dear All,
>
[quoted text clipped - 33 lines]
> Im not good in reading between the lines of this language...please help.
> Thanks in advance.

Reply to this Message

Joel - 24 May 2008 10:51 GMT

Here are two more versions of the macro. The first takes the directory in
cell A1 of the active sheet and gets all the files. The 2nd does everything.
You enter a directory. the code creates a new worksheet for every
sub-directory and put the files names on each sheet.

Sub getdates2()
folder = ActiveSheet.Range("A1")
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(folder)

RowNumber = 2
'folder size in bytes
On Error GoTo 200
For Each fl In folder.files
ActiveSheet.Cells(RowNumber, "C") = fl.DateLastModified
ActiveSheet.Cells(RowNumber, "B") = fl.Size
ActiveSheet.Cells(RowNumber, "A") = strFolder & fl.name
RowNumber = RowNumber + 1
Next fl

200 On Error GoTo 0
End Sub

Sub getdates3()
folder = "H:\My Documents"
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(folder)

'folder size in bytes
On Error GoTo 200

For Each sf In folder.subfolders
Set newsht = Worksheets.Add(after:=Sheets(Sheets.Count))

For Each fl In sf.files
Set newsht = Worksheets.Add(after:=Sheets(Sheets.Count))
newsht.Range("A1") = fl
RowNumber = 2
newsht.Cells(RowNumber, "C") = fl.DateLastModified
newsht.Cells(RowNumber, "B") = fl.Size
newsht.Cells(RowNumber, "A") = fl.name
newsht.name = sf.name
RowNumber = RowNumber + 1
Next fl
Next sf

200 On Error GoTo 0
End Sub

> Dear All,
>
[quoted text clipped - 33 lines]
> Im not good in reading between the lines of this language...please help.
> Thanks in advance.

Reply to this Message

driller - 24 May 2008 11:20 GMT

Dear Mike and Joel,

Thanks for your effort, can we reconcile/converged both of your macro into
one so i can end up with the optimum macro with utmost flexibility for one
workbook with multiple worksheets ?

I appreciate very much for your efforts in helping others.

Signature

regards,

Reply to this Message

driller - 24 May 2008 11:32 GMT

Ooops, my wrong..
I forgot to request that it may be optimum if the filenames retrieved can be
set as hyperlink...Maybe this will suffice the workbook's function as well.
thanks again

Signature

regards,

> Dear Mike and Joel,
>
[quoted text clipped - 3 lines]
>
> I appreciate very much for your efforts in helping others.

Reply to this Message

Mike H - 24 May 2008 12:09 GMT

Hi

Change this line

ActiveSheet.Cells(RowNumber, "A") = strFolder & fl.Name

to this

ActiveSheet.Cells(RowNumber, "A").Hyperlinks.Add
ActiveSheet.Cells(RowNumber, "A"), (Folder & fl.Name)

Mike

> Ooops, my wrong..
> I forgot to request that it may be optimum if the filenames retrieved can be
[quoted text clipped - 8 lines]
> >
> > I appreciate very much for your efforts in helping others.

Reply to this Message

Mike H - 24 May 2008 12:13 GMT

Hi,

That's wrapped, it's all one line

Mike

> Hi
>
[quoted text clipped - 21 lines]
> > >
> > > I appreciate very much for your efforts in helping others.

Reply to this Message

driller - 24 May 2008 12:44 GMT

Mike,
it is so good, can't we eliminate the repeating folder/subfolder names. I
need only to present pure filename*.ext.
Thanks again.

Signature

regards,

> Hi,
>
[quoted text clipped - 27 lines]
> > > >
> > > > I appreciate very much for your efforts in helping others.

Reply to this Message

Mike H - 24 May 2008 15:50 GMT

Try this to eliminate the path

ActiveSheet.Cells(RowNumber, "A").Hyperlinks.Add
ActiveSheet.Cells(RowNumber, "A"), Address:=(Folder & fl.Name),
TextToDisplay:=fl.Name

Once again it's wrapped, it's a single line

Mike

> Mike,
> it is so good, can't we eliminate the repeating folder/subfolder names. I
[quoted text clipped - 32 lines]
> > > > >
> > > > > I appreciate very much for your efforts in helping others.

Reply to this Message