Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
880to884
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
880to884
880to884
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Verzeichnis einlesen und Spalte teilen

Verzeichnis einlesen und Spalte teilen
23.06.2007 14:12:54
mehmet
Hallo Forum,
ich habe mit dem Macrorecorder folgenden Code aufgezeichnet bzw. erweitert:

Sub Verzeichnis_Einlesen()
'Sheet loeschen zwecks Vorbereitung
Rows("4:65536").Select: Selection.Delete Shift:=xlUp
'Dateinamen aus Verzeichnis auslesen mit Endung
Dim laufendeZahl As Integer
With Application.FileSearch
.LookIn = Range("a2").Value 'Verzeichnis-/Pafadname
.Filename = "*.*"           'Dateiendung (*.xls, *.doc, ...)
.Execute
For laufendeZahl = 1 To .FoundFiles.Count
Cells(laufendeZahl + 2, 1).Value = Dir(.FoundFiles(laufendeZahl)) 'mit Extension
Next laufendeZahl
End With
'Spalte Teilen
Application.DisplayAlerts = False
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="$", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2)), _
TrailingMinusNumbers:=True
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Application.DisplayAlerts = True
'Zeilen Beschriften
Range("A3").Select: ActiveCell.FormulaR1C1 = "titel 1"
Range("B3").Select: ActiveCell.FormulaR1C1 = "titel 2"
Range("C3").Select: ActiveCell.FormulaR1C1 = "titel 3"
Range("d3").Select: ActiveCell.FormulaR1C1 = "Datei Endung"
Range("A3:d3").Select: Selection.Interior.ColorIndex = 6
'Hyperlinks einsetzen in Spalte A fuer diese Datei
Dim Zeile As Integer
Zeile = 5
Do Until _
Sheets("Sheet1").Cells(Zeile, 1) = ""
ActiveSheet.Hyperlinks.Add Anchor:=Sheets("Sheet1").Cells(Zeile, 1), _
Address:="" & Sheets("Sheet1").Cells(Zeile, 1), _
ScreenTip:="Hiermit oeffnen Sie: " & Sheets("Sheet1").Cells(Zeile, 1), _
TextToDisplay:="" & Sheets("Sheet1").Cells(Zeile, 1)
Zeile = Zeile + 1
Loop
Range("A1").Select
End Sub


Funktioniert leider nicht ganz, wie ich es haben will.
Es soll das Verzeichnis in Zelle A2 eingelesen werden.
Im Verzeichnis sind Dateien vorhanden, die so aussehen koennten:
mehmet$undso$dann.xls
hallo$du$da.xls
was$geht$ab.doc
was$solldenn$sein.zip
ich$hier.doc
usw.
Die Einlesung Funktioniert.
Die Spaltentrennung funtioniert teilweise (Dateiendung nicht immer in Spalte D.
Die Links funktionieren nicht in Splate A (wird nicht gefunden).
Kann mir jemand bitte helfen.
Dank und Gruss
mehmet

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Verzeichnis einlesen und Spalte teilen
23.06.2007 16:14:00
Case
Hallo,
schau Dir das mal an:
Dateien
Geht schon in Deine Richtung.
Servus
Case

AW: Verzeichnis einlesen und Spalte teilen
23.06.2007 16:45:00
fcs
Hallo mehmet,
Problem mit den Hyperlinks:
du muss den kompletten Dateinamen inkl. Pfad für den Hyperlink wieder zusammenbasteln.
Problem mit der Dateinamenerweiterung:
Die Anzahl der $-Zeichen in den Dateinamen wechselt. Also steht die Dateierweiterung nach dem Aufteilen der Spalten nicht immer in Spalte 3. Hier muss nach dem 1. Spaltensplit zeilenweise die Dateierweiterung ermittelt werden.
Mit nachfolgenden Anpassungen sollte es funktionieren. Ich hab dabei auch die überflüssigen Select-Befehle beseitigt.
Gruß
Franz

Sub Verzeichnis_Einlesen()
Dim laufendeZahl As Integer, Delimit1$, Delimit2$, Dateiname$
Dim Zeile As Integer, wks As Worksheet
Set wks = ActiveSheet 'oder auch = Worksheets("Sheet1")
With wks
'Sheet loeschen zwecks Vorbereitung
.Rows("4:65536").Delete Shift:=xlUp
'Dateinamen aus Verzeichnis auslesen mit Endung
Delimit1 = "$"
Delimit2 = "."
With Application.FileSearch
.LookIn = wks.Range("a2").Value 'Verzeichnis-/Pafadname
.FileName = "*.*"           'Dateiendung (*.xls, *.doc, ...)
.Execute
For laufendeZahl = 1 To .FoundFiles.Count
wks.Cells(laufendeZahl + 3, 1).Value = Dir(.FoundFiles(laufendeZahl)) 'mit Extension
Next laufendeZahl
End With
'Spalte Teilen
Application.DisplayAlerts = False
.Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp)). _
TextToColumns Destination:=.Range("A4"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=Delimit1, FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
'Dateinamenserweiterung in Spalte 4 eintragen
For Zeile = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row
For Spalte = 3 To 1 Step -1
If .Cells(Zeile, Spalte)  "" Then
If InStr(1, .Cells(Zeile, Spalte), Delimit2) > 0 Then 'Prüfung ob Punkt im Text
.Cells(Zeile, 4) = Mid(.Cells(Zeile, Spalte), InStr(1, .Cells(Zeile, Spalte), _
Delimit2) + 1)
.Cells(Zeile, Spalte) = Left(.Cells(Zeile, Spalte), InStr(1, .Cells(Zeile, Spalte), _
Delimit2) - 1)
End If
End If
Next
Next
Application.DisplayAlerts = True
'Zeilen Beschriften
.Range("A3").Value = "titel 1"
.Range("B3").Value = "titel 2"
.Range("C3").Value = "titel 3"
.Range("d3").Value = "Datei Endung"
.Range("A3:d3").Interior.ColorIndex = 6
'Hyperlinks einsetzen in Spalte A fuer diese Datei
For Zeile = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Dateinamen wieder zusammenbasteln
Dateiname = .Cells(2, 1) & "\" & .Cells(Zeile, 1) _
& IIf(.Cells(Zeile, 2)  "", Delimit1, "") & .Cells(Zeile, 2) _
& IIf(.Cells(Zeile, 3)  "", Delimit1, "") & .Cells(Zeile, 3) _
& Delimit2 & .Cells(Zeile, 4)
'Hyperlink zuweisen
.Hyperlinks.Add Anchor:=.Cells(Zeile, 1), _
Address:=Dateiname, _
ScreenTip:="Hiermit oeffnen Sie: " & Dateiname, _
TextToDisplay:="" & Dateiname
Next
End With
Range("A1").Select
End Sub


Anzeige
AW: Verzeichnis einlesen und Spalte teilen
23.06.2007 21:06:39
mehmet
Hallo Franz, hallo Case,
herzlichen Dank für eure Hilfe.
Franz, ich versuche die ganze Zeit den Code anzupassen, es will nicht!
Ich habe probleme mit:
'Dateinamenserweiterung in Spalte 4 eintragen
For Zeile = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row
For Spalte = 3 To 1 Step -1
If .Cells(Zeile, Spalte) <> "" Then
If InStr(1, .Cells(Zeile, Spalte), Delimit2) > 0 Then 'Prüfung ob Punkt im Text
.Cells(Zeile, 4) = Mid(.Cells(Zeile, Spalte), InStr(1, .Cells(Zeile, Spalte), _
Delimit2) + 1)
.Cells(Zeile, Spalte) = Left(.Cells(Zeile, Spalte), InStr(1, .Cells(Zeile, Spalte), _
Delimit2) - 1)
End If
End If
Next
Next
Application.DisplayAlerts = True
Könntest du es bitte so einrichten, dass in Spalte D4:D65536 in Zellen
die letzten 4 Endungen (also Dateiendung wie .xls oder .doc) diese in Splaten D und E Teilen soll.
Dank und Gruss
mehmet

Anzeige
AW: Verzeichnis einlesen und Spalte teilen
24.06.2007 00:11:13
fcs
Hallo Mehmet,
ich versteh nicht ganz was du möchtest. Soll die Dateiendung jetzt immer in die Spalte E geschrieben werden, oder nur in Ausnahmefällen?
Denke bitte daran, dass du auch den Code für das Erzeugen des Dateinamens im Hyperlink anpassen muss, wenn du die Spalten für das Aufteilen des Dateinamens änderst. Wobei es ggf. einfacher wäre wenn du die Hyperlinks erzeugst, bevor du die Dateinamen auf mehrere Spalten aufteilst.
Gruß
Franz

AW: Verzeichnis einlesen und Spalte teilen
24.06.2007 10:46:00
mehmet
Hallo Franz,
ja, die Datenendung soll immer in Spalte E stehen und dein vorschlag, den Hyperling klinkt logisch.
Aber man könnte doch die Zellen später verbinden in einer anderen Spalte mit =B2&C2&...&E2.
Diese dann in VBA nicht als Formel sondern als Wert. Und diesen Vorgang mit einer Schleife, bis
die die Zeile leer ist.
Gruss
mehmet

Anzeige
AW: Verzeichnis einlesen und Spalte teilen
24.06.2007 15:44:00
fcs
Hallo Mehmet,
hier der angepasste Code. Die Dateiendungen werden nach Spalte E geschrieben. Den Abschnitt für den Hyperlink hab ich entsprechend ergänzt.
Gruß
Franz

Sub Verzeichnis_Einlesen()
Dim laufendeZahl As Integer, Delimit1$, Delimit2$, Dateiname$
Dim Zeile As Integer, wks As Worksheet
Set wks = ActiveSheet
With wks
'Sheet loeschen zwecks Vorbereitung
.Rows("4:65536").Delete Shift:=xlUp
'Dateinamen aus Verzeichnis auslesen mit Endung
Delimit1 = "$"
Delimit2 = "."
With Application.FileSearch
.LookIn = wks.Range("a2").Value 'Verzeichnis-/Pafadname
.FileName = "*.*"           'Dateiendung (*.xls, *.doc, ...)
.Execute
For laufendeZahl = 1 To .FoundFiles.Count
wks.Cells(laufendeZahl + 3, 1).Value = Dir(.FoundFiles(laufendeZahl)) 'mit Extension
Next laufendeZahl
End With
'Spalte Teilen
Application.DisplayAlerts = False
.Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp)). _
TextToColumns Destination:=.Range("A4"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=Delimit1, FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
'Dateinamenserweiterung in Spalte 5 eintragen
For Zeile = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row
For Spalte = 4 To 1 Step -1
If .Cells(Zeile, Spalte)  "" Then
If InStr(1, .Cells(Zeile, Spalte), Delimit2) > 0 Then 'Prüfung ob Punkt im Text
.Cells(Zeile, 5) = Mid(.Cells(Zeile, Spalte), InStr(1, .Cells(Zeile, Spalte), _
Delimit2) + 1)
.Cells(Zeile, Spalte) = Left(.Cells(Zeile, Spalte), InStr(1, .Cells(Zeile, Spalte), _
Delimit2) - 1)
End If
End If
Next
Next
Application.DisplayAlerts = True
'Zeilen Beschriften
.Range("A3").Value = "titel 1"
.Range("B3").Value = "titel 2"
.Range("C3").Value = "titel 3"
.Range("D3").Value = "titel 4"
.Range("E3").Value = "Datei Endung"
.Range("A3:e3").Interior.ColorIndex = 6
'Hyperlinks einsetzen in Spalte A fuer diese Datei
For Zeile = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Dateinamen wieder zusammenbasteln
Dateiname = .Cells(2, 1) & "\" & .Cells(Zeile, 1) _
& IIf(.Cells(Zeile, 2)  "", Delimit1, "") & .Cells(Zeile, 2) _
& IIf(.Cells(Zeile, 3)  "", Delimit1, "") & .Cells(Zeile, 3) _
& IIf(.Cells(Zeile, 4)  "", Delimit1, "") & .Cells(Zeile, 4) _
& Delimit2 & .Cells(Zeile, 5)
'Hyperlink zuweisen
.Hyperlinks.Add Anchor:=.Cells(Zeile, 1), _
Address:=Dateiname, _
ScreenTip:="Hiermit oeffnen Sie: " & Dateiname, _
TextToDisplay:="" & Dateiname
Next
End With
Range("A1").Select
End Sub


Anzeige
AW: Verzeichnis einlesen und Spalte teilen
24.06.2007 16:17:00
mehmet
Hallo Franz,
dank dir, dass du dich nochmal meldest.
Etwas scheint nicht ganz in Ordnung zu sein!
Nach einlesen sieht es so aus:
Spalte A: kompleter Pfad zwecks Link (es funktioniert und ist ok)
Spalte B: hier steht das drin, was in Spalte C stehen soltte.
Spalte C: hier steht das drin, was in Splate D stehen sollte.
Spalte D: ist leer, sollte aber das stehen, was in Splate C steht
Spalte E: hier die Dateiendung, leider nur die Exceldateien werden aufgelistet statt alle vorhandene
Dank und Gruss
mehmet

AW: Verzeichnis einlesen und Spalte teilen
26.06.2007 07:07:00
fcs
Hallo Mehmet,
du scheinst die Prozedur ja noch ein wenig geändert zu haben. Dann wär es natürlich hilfreich, wenn du sie hier komplett postest.
Das Problem mit der Erweitererung des Dateinamens in Spalte D kann ich nicht nachvollziehen. Das funktioniert bei mir (EXCEL97, WIN98) einwandfrei bei allen Dateitypen. Wichtig ist, daas hier natürlich mit dem Dateinamen die Erweiterung auch eingelesen wird. Als Dateinamenserweiterung werden die Zeichen rechts eines Punktes im letzten gesplitteten Textsegment erkannt.
Das Makro macht jetzt folgendes:
1. in Spalte A: Alle Dateinamen aus Verzeichnis einlesen
2. An den $-Zeichen werden die Dateinamen in Spalte A geteilt und die Teile in den Spalten B, C usw. eingetragen
3. Aus dem letzten Texteintrag in den Spalten B bis D in jeder Zeile wird die Erweiterung des Daeinamens abgetrennt und in Spalte E eingetrsgen
4. Spaltentitel werden eingetragen
5. Je Zeile wird der komplette Datename ermittelt und in Spalte A wird der Zelle ein Hyperlink auf die Datei zugewiesen.
Gruß
Franz

Sub Verzeichnis_Einlesen()
Dim laufendeZahl As Integer, Delimit1$, Delimit2$, Dateiname$
Dim Zeile As Integer, wks As Worksheet
Set wks = ActiveSheet
With wks
'Sheet loeschen zwecks Vorbereitung
.Rows("4:65536").Delete Shift:=xlUp
'Dateinamen aus Verzeichnis auslesen mit Endung
Delimit1 = "$"
Delimit2 = "."
With Application.FileSearch
.LookIn = wks.Range("a2").Value 'Verzeichnis-/Pafadname
.FileName = "*.*"           'Dateiendung (*.xls, *.doc, ...)
.Execute
For laufendeZahl = 1 To .FoundFiles.Count
wks.Cells(laufendeZahl + 3, 1).Value = Dir(.FoundFiles(laufendeZahl)) 'mit Extension
Next laufendeZahl
End With
'Spalte Teilen
Application.DisplayAlerts = False
.Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp)). _
TextToColumns Destination:=.Range("B4"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=Delimit1, FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))
'Dateinamenserweiterung in Spalte 5 eintragen
For Zeile = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row
For Spalte = 4 To 2 Step -1
If .Cells(Zeile, Spalte)  "" Then
If InStr(1, .Cells(Zeile, Spalte), Delimit2) > 0 Then 'Prüfung ob Punkt im Text
.Cells(Zeile, 5) = Mid(.Cells(Zeile, Spalte), InStr(1, .Cells(Zeile, Spalte), _
Delimit2) + 1)
.Cells(Zeile, Spalte) = Left(.Cells(Zeile, Spalte), InStr(1, .Cells(Zeile, Spalte), _
Delimit2) - 1)
End If
End If
Next
Next
Application.DisplayAlerts = True
'Zeilen Beschriften
.Range("A3").Value = "titel 1"
.Range("B3").Value = "titel 2"
.Range("C3").Value = "titel 3"
.Range("D3").Value = "titel 4"
.Range("E3").Value = "Datei Endung"
.Range("A3:e3").Interior.ColorIndex = 6
'Hyperlinks einsetzen in Spalte A fuer diese Datei
For Zeile = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Dateinamen wieder zusammenbasteln
Dateiname = .Cells(2, 1) & "\" & .Cells(Zeile, 1)
'Hyperlink zuweisen
.Hyperlinks.Add Anchor:=.Cells(Zeile, 1), _
Address:=Dateiname, _
ScreenTip:="Hiermit oeffnen Sie: " & Dateiname, _
TextToDisplay:="" & Dateiname
Next
End With
Range("A1").Select
End Sub


Anzeige
AW: Verzeichnis einlesen und Spalte teilen
26.06.2007 10:01:00
mehmet
Hallo Franz,
super, dass du dich noch meldest.
Es funktioniert einwandfrei. Ich habe lange daran gesesen und war nicht zu einer fernünftigen Lösungen gekommen.
Dank nochmal.
Eine Frage hätte ich noch bitte, wenn ich dich nicht zu sehr mit dieser Angelegenheit aufhalte.
Warum werden *.zip Dateien nicht eingelesen bei mir. Sonst wird doch alles angezeigt.
Nochmal herzlichen Dank für deine Rückmeldung.
Gruss
mehmet

AW: Verzeichnis einlesen und Spalte teilen
26.06.2007 20:38:56
fcs
Hallo Mehmet,
bei meinem Opa von Betriebssystem (WIN98) listet das Makro auch die ZIP-Dateien in der Exceltabelle.
Wenn ich mich recht erinnere, dann können die neueren Windowsversionen ZIP-Dateien wie Ordner behandeln/darstellen. Ich weiss aber nicht, ob das eine Option des Windows-Betriebssystems ist oder ein Addin, das mit WinZip oder ähnlichen Programmen installiert wird.
Möglicherweise ist dies ein Grund, dass die ZIP-Dateienbei dir nicht als Dateien gelistet werden.
Gruß
Franz

Anzeige
OK, Dank dir o.T.
27.06.2007 10:37:00
mehmet
.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige