sooooo:
after having thought way too complicated,
i realized there is a simple solution: - (the changes i made are in
the last 8 lines...)
it all works perfect now, thanx again for your help:
--------------------- subfolder-macro ------------------
ActiveSheet.Unprotect Password:="xxx"
Dim fso, f, sf, fldr, folderlist
Dim I
Set fso = CreateObject("Scripting.FileSystemObject")
For I = 9 To 1000 'Assuming less than 1000 lines!
If (Cells(I, 1) <> "") Then
'Cells(I, 2) = "" 'Clears existing
data
If (fso.folderexists(Cells(I, 1))) Then 'Avoids errors if
folder does not exist
folderlist = "" 'Clears list from
previous folder
Set f = fso.GetFolder(Cells(I, 1)) 'Gets folder data
from A
Set sf = f.SubFolders 'Gets list of
subfolders
For Each fldr In sf
If (folderlist = "") Then 'First folder
doesn't need a (,)
folderlist = fldr.Name '
Else
folderlist = folderlist & ", " & fldr.Name
End If
Next fldr
If (Cells(I, 2) <> folderlist) Then ' check if
subfolderlist is up-to-date
Cells(I, 2) = "" 'clears old
list before adding list
Cells(I, 2) = folderlist 'Add list to
cell
End If
End If
End If
Next I
ActiveSheet.Unprotect Password:="xxx"
-----------------------------------------------------------------
the timestamp macro is seperate, since it should also work for manual
changes, i put it behind the sheet:
----------- timestamp-macro ------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="xxx"
For Each Cell In Target
If Cell.Column <= 3 Then
If Cells(Cell.Row, 1) <> "" Or Cells(Cell.Row, 2) <> "" Or Cells
(Cell.Row, 3) <> "" Then Cells(Cell.Row, 4) = Now
If Cells(Cell.Row, 2) = "" And Cells(Cell.Row, 3) = "" Then Cells
(Cell.Row, 4) = ""
End If
Next Cell
ActiveSheet.Protect Password:="xxx"
End Sub
-------------------------------------
On 10 Feb., 17:51, Paul Schreiner <schreiner_p...@att.net> wrote:
> I'll let you play a bit with this one.
> But here's some clues:
>
> the line: set f = fso.Getfolder(...)
> stores a LOT of info about the folder in the structure "f".
> One attribute is "datelastmodified" (look in the Help)
> so.. I'm guessing that the timestamp is for the subfolder,
> so you'll want to get the folder info about the subfolder:
>
> (set f2 = fso.getfolder(cells(I,1) & "\" & sf.name))
>
> fs2.datelastmodified will be the datestamp of the folder.
>
> You can use DateDiff (check the help!)
> to see if they are different...
>
> see what you can come up with..
>
> Paul
>
> ----- Original Message ----
> > From: Tobi Hammet <speich...@gmail.com>
> > To: MS EXCEL AND VBA MACROS <excel-macros@googlegroups.com>
> > Sent: Tuesday, February 10, 2009 9:29:47 AM
> > Subject: $$Excel-Macros$$ Re: VBA: Entering a Foldername in Collumn A
> > should list me its Subfolders in B (comma seperated)
>
> > This is great!
> > This is so clearly structured, and it does almost exactly what i
> > wanted...
> > Thanks a lot!
> > The only thing that is not perfect, is that i have a timestamp in
> > Collumn C,
> > and now, wenn i Update, (by executing the macro), i get a new
> > timestamp in C, even if there is no change.
> > How can i first compare, and if there is no change, leave the cell
> > untouched?
>
> > Thanks again,
> > Tobias
>
> > On 10 Feb., 13:43, Paul Schreiner wrote:
> > > It's actually not that difficult.
> > > In fact, if you look for "subfolders" in the VBA help, it gives a pretty
> > > good
> > example.
>
> > > I modified it like this:
>
> > > Option Explicit
> > > Sub find_folder()
> > > Dim fso, f, sf, fldr, folderlist
> > > Dim I
> > > Set fso = CreateObject("Scripting.FileSystemObject")
> > > For I = 1 To 1000 'Assuming less than 1000 lines!
> > > If (Cells(I, 1) <> "") Then
> > > Cells(I, 2) = "" 'Clears existing data
> > > If (fso.folderexists(Cells(I, 1))) Then 'Avoids errors if
> > > folder
> > does not exist
> > > folderlist = "" 'Clears list from
> > previous folder
> > > Set f = fso.GetFolder(Cells(I, 1)) 'Gets folder data
> > > Set sf = f.SubFolders 'Gets list of
> > > subfolders
> > > For Each fldr In sf
> > > If (folderlist = "") Then 'First folder doesn't
> > need a (,)
> > > folderlist = fldr.Name '
> > > Else
> > > folderlist = folderlist & ", " & fldr.Name
> > > End If
> > > Next fldr
> > > Cells(I, 2) = folderlist 'Add list to cell
> > > End If
> > > End If
> > > Next I
> > > End Sub
>
> > > I put the above into VBA module
>
> > > hth,
>
> > > Paul
>
> > > ----- Original Message ----
> > > > From: Tobi Hammet
> > > > To: MS EXCEL AND VBA MACROS
> > > > Sent: Monday, February 9, 2009 4:25:15 PM
> > > > Subject: $$Excel-Macros$$ VBA: Entering a Foldername in Collumn A should
> > list me its Subfolders in B (comma seperated)
>
> > > > I have the following folder(or directory) structure:
>
> > > > list_folders.xls (in ROOT)
> > > > &
> > > > /Folder01/Subfolder01
> > > > /Folder01/Subfolder02
> > > > /Folder02/Subfolder01
> > > > /Folder02/Subfolder02
>
> > > > I want the makro to read the foldernames in Column A, and as a result
> > > > i would like to see the Subfolder Names in Column B (Seperated by
> > > > comma)
> > > > Btw. Subfolders deeper than that can be ignored - so its basically
> > > > about the subfolders on "level 2".
>
> > > > So with the above folder structure, having filled in A1&A2 before, it
> > > > should look like this:
>
> > > > A1="Folder01" >> B1="Subfolder01,Subfolder02"
> > > > A2="Folder02" >> B2="Subfolder02,Subfolder02"
>
> > > > PS:
> > > > I uploaded a excel-file here that shows more graphically what i need -
> > > > also with a screenshot:
> > > >http://sites.google.com/site/excelauswahl/excel-vba
>
> > > > Can anyone solve this?
> > > > It seems quite tricky...
--~--~---------~--~----~------------~-------~--~----~
Visit the blog to download Excel tutorials at
http://www.excel-macros.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
For more options, visit this group at
http://groups.google.com/group/excel-macros?hl=en
Visit & Join Our Orkut Community at
http://www.orkut.com/Community.aspx?cmm=22913620
To Learn VBA Macros Please visit http://www.vbamacros.blogspot.com
To see the Daily Excel Tips, Go to:
http://exceldailytip.blogspot.com
If you find any spam message in the group, please send an email to Ayush @
jainayus...@gmail.com
-~----------~----~----~----~------~----~------~--~---
