VBA Ordner auslesen ( Bezugs durch Zellwert )
05.09.2018 11:42:17
udo
sollte bitte eure Hilfe beanspruchen für folgende Problematik.
Vorab - habe mir gestern über die Recherche einen Vba Code zusammengesucht und
etwas an meine Bedürfnisse angepasst. Funktioniert soweit auch .. Kern meiner Fragestellung ist die Pfadbezeichnung im Code oben ...
Const sRootPath As String = "C:\Users\......\Downloads" ' Pfad noch anpassen
Ich würde gerne diese Pfadangabe einfach auf eine Zelle ( zB. F2 in Tabelle1 )
umlegen, sprich in trage dort den Pfad in Textform ein ... und der Code prüft als Bezug diesen Zelleintrag und sucht dann dort ...
Hier mal der ganze Code zum Ordner auslesen wie ich ihn verwende,
Von hier ab :
Option Explicit
Option Compare Text
Const sRootPath As String = "C:\Users\......\Downloads" ' Pfad anpassen - ohne Backslash am Ende !
Private lRowCounter As Long
Private oSheet As Object
Public Sub MWDateienMitUnterordnernAuslesen()
' _
zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz
' Dim sRootPath As String
'sRootPath = [F1].Text
' Set oSheet = Sheets.Add ' wenn in ein neues Tabellenblatt eingelesen werden soll
Set oSheet = Sheets("Tabelle1")
oSheet.Activate
oSheet.Cells(1, 2).Select
lRowCounter = 12 ' beginnt ab Zeile 12 einzutragen
Call MWReadSubFolder(sRootPath)
Set oSheet = Nothing
End Sub
Private Sub MWReadSubFolder(ByVal sPath As String)
' _
zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.getfolder(sPath)
With oSheet
For Each oSubFolder In oFolder.subfolders
' Alle Dateien auflisten
For Each oFile In oSubFolder.Files
.Cells(lRowCounter, 2) = oSubFolder.Path ' definiert die 1. Spalte in _
_
_
der eingetragen wird
.Cells(lRowCounter, 3) = oFile.Name ' def. die 2. Spalte ...
lRowCounter = lRowCounter + 1
Next oFile
' Alle Unterverzeichnisse verarbeiten (rekursiv)
Call MWReadSubFolder(oSubFolder.Path)
Next oSubFolder
End With
Set oFSO = Nothing
Set oFile = Nothing
Set oFolder = Nothing
Set oSubFolder = Nothing
End Sub
Großen Dank & Grüße udo