Verzeichnis auslesen

Hallo zusammen,
da ich mehr in HTML Webdesign zuhause bin könnte ich einmal Eure Hilfe gebrauchen. Ich weiß, daß man mit Excel und VBA bestimmte Verzeichnisse(CD-ROM oder Festplatte, z.B. "d:\..\") auslesen kann. Ich weiß aber nicht wie. Und zwar sollte das Stammverzeichnis namentlich in Spalte A genannt werden, ist hier eine Datei gefunden, so soll diese in Spalte B aufgeführt sein. Ist in Spalte B aber noch ein Unterverzeichnis, dann soll die Datei in Spalte C erscheinen(mit Dateiendung), usw...

Excel ist mir deshalb wichtig, da die Daten dann gut via ODBC in meine SQL SERVER Datenbank eingelesen werden können.

Könnte mir hier jemand Hilfe leisten, oder hab ich nicht richtig gesucht, und es gibt hier schon einen ähnlichen Beitrag den ich verwenden kann und darf.

Danke für Eure Hilfe

Mit freundlichen Grüßen aus Thüringen

Stephan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Stephan,

ich habe folgendes Makro im Einsatz es liefert zwar nicht die gewünschte Aufteilung in Spalten, aber vieleicht kannst Du es auf deine Wünsche anpassen.

Sub Alle_Auflisten()

Dim Datei As FileSearch
Dim i As Integer
Set Datei = Application.FileSearch
On Error Resume Next
Dim SuchText, SuchZeichen, Pos0, Pos(1 To 10), AA, BB, CC
verz = InputBox("Welches Verzeichnis soll aufgelistet werden ? ", , "K:/CBU_DC")
DA = InputBox("welche Dateiart soll aufgelistet werden ? ", , "*.xls")
Rows("2:60000").ClearContents
Range("A2:A60000").Select
With Selection.Font
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Application.Calculation = xlManual
With Datei
.FileName = DA
.LookIn = verz
.SearchSubFolders = True
If .Execute > 0 Then
MsgBox "Es gibt " & .FoundFiles.Count & " Dateien <" & DA & ">"
For i = 1 To .FoundFiles.Count
'MsgBox .FoundFiles(i) ', Password:="DeinPasswort"
Cells(i + 1, 1).Value = .FoundFiles(i)
Next
End If
End With
Application.Calculation = xlCalculationAutomatic

For AA = 2 To 10000
SuchText = Cells(AA, 1).Value
If SuchText = "" Then Exit Sub
SuchZeichen = "\"
Pos1 = InStr(1, SuchText, SuchZeichen, 1)
For BB = 2 To 10
Pos(BB) = InStr(Pos(BB - 1) + 1, SuchText, SuchZeichen, 1)

Next BB
For CC = 1 To 10
If Pos(CC) > Pos(CC + 1) Then Pos0 = Pos(CC): Exit For
Next CC
Application.Cells(AA, 2).Value = Mid(SuchText, Pos0 + 1)
Next AA
End Sub

Gruß Joachim

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread