Scripting.FileSystemObject-Probl. beim Dateikopier
24.02.2009 16:16:28
Tobias
Untenstehende Funktion liesst Ordnernamen in Spalte A aus und schreibt die Unterordner kommagetrennt in Spalte B. Das klappt auch gut, nur:
Sobald ich die Exceldatei in ein anderes Verzeichnis kopiere, klappts nicht nicht mehr.
Erst wieder, wenn ich auf: Speichern unter ... Gleicher Dateiname ... Ersetzen gehe und das makro nochmal starte, klappts.
Ich vermute das hat was mit dem Scripting.FileSystemObject zu tun, das beim kopieren der Datei offenbar nicht aktualisiert wird ? Oder ein Excel-Bug?
Grüsse,
Tobias
-------
Option Explicit
Sub find_folder_exp()
ActiveSheet.Unprotect Password:="yyy"
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.Protect Password:="yyy"
ActiveSheet.EnableAutoFilter = True
End Sub