Hilfe mit kleiner Code-Anpassung - Dateiimport
04.03.2013 11:29:16
Tim
ich verwende folgenden Code, mit dem ich die Dateinamen aus einem Ordner auslese und in eine Tabelle schreibe.
Das funktioniert soweit gut.
Ich suche nun nach einem Weg, die Dateinamen aus drei verschiedenen Ordnern statt nur aus einem auszulesen (die Ordner sind dabei immer die gleichen).
Kann mir jemand sagen, was ich dazu ändern muss ?
Wichtig ist mir dabei, dass die Dateinamen am Ende untereinander geschrieben werden, so dass die einzelnen Ordner sich nicht gegenseitig überschreiben.
Sub ImportFiles()
Dim dlg As FileDialog, TB, SP%, ZE&
Dim Si, Ext$, Datei$
Set TB = Worksheets(3)
Set dlg = Application.FileDialog(msoFileDialogFolderPicker) 'folder picker
SP = 19 'column for temporary file import
ZE = 2 'row for temporary file import
Application.ScreenUpdating = False
Worksheets(3).Range("S2:S1000").ClearContents
If dlg.Show = True Then
For Each Si In dlg.SelectedItems
Ext = "*.*" 'or "*.xls*" for specific file extensions only
Si = IIf(Right(Si, 1) = "\", Si, Si & "\")
Datei = Dir(Si & Ext)
Do While Len(Datei) > 0
TB.Cells(ZE, SP) = Datei
ZE = ZE + 1
Datei = Dir() 'next file
Loop
Next
End If
'tranferring temporary file list to column A
With ActiveWorkbook.Worksheets(3)
.Range("S2:S1000").Copy
.Range("A2:A1000").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
.Range("S2:S1000").ClearContents
Application.ScreenUpdating = True
Application.Goto .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
End Sub
VG und vielen Dank im Voraus,
Tim