Unterordner auslesen

Moderator: ModerationP

Unterordner auslesen

Beitragvon wut » 08. Sep 2021, 12:50

Hallo zusammen,

ich bin auf der Suche nach einem Makro, was folgendes tun sollte (bitte).

Das Excel liegt in einem Hauptordner in diesem befinden sich Unterordner und in diesen auf noch mal Unterordner.

Jetzt wäre mein Wunsch das er diese Ordner alle ausliest und wie folgt ausgibt:

in Spalte a - die Dateinamen
in Spalte b - den Pfad

dabei ist es egal ob es Bilder Exceldateien oder PDFs sind

ich hatte schon mal so einen Code bloß der läuft nicht mehr unter dem Office 365

Danke im Voraus
Marcus
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 396
Registriert: 21. Sep 2005, 11:32

Re: Unterordner auslesen

Beitragvon Flotter Feger » 08. Sep 2021, 13:01

gelöscht ... völlig sinnlos nach Eigeninitiative zu fragen
Zuletzt geändert von Flotter Feger am 08. Sep 2021, 13:09, insgesamt 1-mal geändert.
Benutzeravatar
Flotter Feger
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 3327
Registriert: 24. Okt 2016, 16:40

Re: Unterordner auslesen

Beitragvon Nepumuk » 08. Sep 2021, 13:01

Hallo Marcus,

teste mal:

Code: Alles auswählen
Option Explicit

Public Sub Beispiel()
    Const FOLDER_PATH As String = "G:\Eigene Dateien\" 'Anpassen, Backslash am Ende nicht löschen
    Dim astrFolders() As String, strFilename As String
    Dim ialngFolders As Long, lngRow As Long
    astrFolders = GetFolders(FOLDER_PATH)
    For ialngFolders = LBound(astrFolders) To UBound(astrFolders)
        strFilename = Dir$(astrFolders(ialngFolders) & ".")
        Do Until strFilename = vbNullString
            lngRow = lngRow + 1
            Cells(lngRow, 1).Value = strFilename
            Cells(lngRow, 2).Value = astrFolders(ialngFolders) & strFilename
            strFilename = Dir$
        Loop
    Next
End Sub

Private Function GetFolders(ByVal pvstrPath As String) As String()
    Dim astrFolders() As String
    Dim strFolder As String, strPath As String
    Dim ialngIndex1 As Long, ialngIndex2 As Long
    ReDim Preserve astrFolders(ialngIndex1)
    astrFolders(ialngIndex1) = pvstrPath
    ialngIndex1 = 1
    ialngIndex2 = 1
    strPath = pvstrPath
    Do
        strFolder = Dir$(PathName:=strPath & "*", Attributes:=vbDirectory)
        Do Until strFolder = vbNullString
            If strFolder <> "." And strFolder <> ".." Then
                If GetAttr(PathName:=strPath & strFolder) And vbDirectory Then
                    ReDim Preserve astrFolders(0 To ialngIndex1)
                    astrFolders(ialngIndex1) = strPath & strFolder & "\"
                    ialngIndex1 = ialngIndex1 + 1
                End If
            End If
            strFolder = Dir$
        Loop
        If ialngIndex1 = ialngIndex2 Then Exit Do
        strPath = astrFolders(ialngIndex2)
        ialngIndex2 = ialngIndex2 + 1
    Loop
    GetFolders = astrFolders
End Function
De fontibus non est disputandum

Gruß
Nepumuk 8-)
Benutzeravatar
Nepumuk
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 15222
Registriert: 10. Aug 2004, 08:40
Wohnort: Regensburg

Re: Unterordner auslesen

Beitragvon wut » 08. Sep 2021, 13:27

@ Flotter Feger,

ich habe schon mehrere Codes ausprobiert, aber alle haben noch Zusatzfunktionen mit drin wie Hyperlink usw. Die ich nicht brauche und durch meine schwachen VBA Kenntnisse auch nicht ausschalten kann.
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 396
Registriert: 21. Sep 2005, 11:32

Re: Unterordner auslesen

Beitragvon wut » 08. Sep 2021, 13:37

@Nepumuk

danke für den Code

Perfekt danke.

Jetzt habe ich noch eine Frage (oder soll ich dafür einen neuen Post öffnen)

C:\Basic - XXX\1 Büro\Büro\Tobi\1.doc

der Pfad ist ja FIX, würde das auch funktionieren das der dynamisch ist?

ich würde mir aus dem Ergebnis von deinem Code gerne eine Hyperlinkliste bauen die ich verschieben kann daher - im VBA würde es ja thisworkbook usw. Bloß wie macheich das mit einem Link?

??? XXX\1 Büro\Büro\Tobi\1.doc

dankeschön
marcus
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 396
Registriert: 21. Sep 2005, 11:32

Re: Unterordner auslesen

Beitragvon Nepumuk » 08. Sep 2021, 14:38

Hallo Marcus,

was meinst du mit dynamisch? Einen Pfad aus einer Excelzelle oder einen Dialog zum auswählen des Ordners?

Ich kann die die Pfade der Hyperlinks absolut machen so dass es keine Rolle spielt wo sich die Mappe befindet.
De fontibus non est disputandum

Gruß
Nepumuk 8-)
Benutzeravatar
Nepumuk
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 15222
Registriert: 10. Aug 2004, 08:40
Wohnort: Regensburg

Re: Unterordner auslesen

Beitragvon wut » 08. Sep 2021, 15:45

Hallo Nepumuk,

ich dachte absolut heißt c:\ordner\ordner\test.txt
wenn ich dich verstanden habe würde dann das C keine Rolle spielen?

Das wäre natürlich super.

Zur Erklärung:

Hier im Verein habe ich für jeden Schützen einen Ordner mit seinen Stammblatt und noch 2-3 andere Dateien

Jetzt wäre es schick wenn ich da drauf über ein Excelblatt zugreifen könnte ohne jedesmal die Links neu zu machen wenn ein neuer kommt.

Somit könnte ich die Ordner und Unterordner auslesen lassen und mit zu den Dateien einen Link basteln.

Und wenn ich das noch auf nen Stick packen könnte und es funktioniert wäre genial.

Ein Makro, wo ich den Hauptordner auswählen kann und in diesem werden dann alle Unterordner ausgelesen und alle Dateien (xlsm und pdf und jpeg) werden mit einem Link in der Datei angezeigt wäre genial.

Wohin muss das Bier?


Vielen lieben Dank im Voraus
Marcus
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 396
Registriert: 21. Sep 2005, 11:32

Re: Unterordner auslesen

Beitragvon Nepumuk » 08. Sep 2021, 16:16

Hallo Marcus,

so ok?

Code: Alles auswählen
Option Explicit

Public Sub CreateHyperlinks()

    Dim astrFolders() As String, strFilename As String, strFoder As String
    Dim ialngFolders As Long, lngRow As Long
    Dim objFileDialog As FileDialog

    Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

    With objFileDialog
        .AllowMultiSelect = False
        .Title = "Order auswählen"
        If .Show Then strFoder = .SelectedItems(1) & "\"
    End With

    Set objFileDialog = Nothing

    If strFoder <> vbNullString Then

        Call Columns("A:B").ClearContents

        astrFolders = GetFolders(strFoder)

        For ialngFolders = LBound(astrFolders) To UBound(astrFolders)

            strFilename = Dir$(astrFolders(ialngFolders) & ".")

            Do Until strFilename = vbNullString

                lngRow = lngRow + 1

                Cells(lngRow, 1).Value = strFilename
                Call Cells(lngRow, 2).Hyperlinks.Add(Anchor:=Cells(lngRow, 2), Address:= _
                    astrFolders(ialngFolders) & strFilename, ScreenTip:=strFilename, TextToDisplay:=strFilename)

                strFilename = Dir$

            Loop
        Next
    End If
End Sub

Private Function GetFolders(ByVal pvstrPath As String) As String()
    Dim astrFolders() As String
    Dim strFolder As String, strPath As String
    Dim ialngIndex1 As Long, ialngIndex2 As Long
    ReDim Preserve astrFolders(ialngIndex1)
    astrFolders(ialngIndex1) = pvstrPath
    ialngIndex1 = 1
    ialngIndex2 = 1
    strPath = pvstrPath
    Do
        strFolder = Dir$(PathName:=strPath & "*", Attributes:=vbDirectory)
        Do Until strFolder = vbNullString
            If strFolder <> "." And strFolder <> ".." Then
                If GetAttr(PathName:=strPath & strFolder) And vbDirectory Then
                    ReDim Preserve astrFolders(0 To ialngIndex1)
                    astrFolders(ialngIndex1) = strPath & strFolder & "\"
                    ialngIndex1 = ialngIndex1 + 1
                End If
            End If
            strFolder = Dir$
        Loop
        If ialngIndex1 = ialngIndex2 Then Exit Do
        strPath = astrFolders(ialngIndex2)
        ialngIndex2 = ialngIndex2 + 1
    Loop
    GetFolders = astrFolders
End Function
De fontibus non est disputandum

Gruß
Nepumuk 8-)
Benutzeravatar
Nepumuk
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 15222
Registriert: 10. Aug 2004, 08:40
Wohnort: Regensburg

Re: Unterordner auslesen

Beitragvon wut » 08. Sep 2021, 16:37

@Nepumuk

läuft genial. Danke

Das bedeutet solange ich die Ordnerstruktur in dem Ordner wo das Excel liegt nicht verändere - funktionieren die Links immer? einfach spitze

Würde das eigentlich auch mit Ordner funktionieren?


Bin echt tief in deiner Schuld danke

gruß
Marcus
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 396
Registriert: 21. Sep 2005, 11:32

Re: Unterordner auslesen

Beitragvon Nepumuk » 08. Sep 2021, 16:45

Hallo Marcus,

Würde das eigentlich auch mit Ordner funktionieren?


Klar.
De fontibus non est disputandum

Gruß
Nepumuk 8-)
Benutzeravatar
Nepumuk
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 15222
Registriert: 10. Aug 2004, 08:40
Wohnort: Regensburg

Re: Unterordner auslesen

Beitragvon wut » 08. Sep 2021, 18:01

ok,

werde es mal versuchen den Code zu verstehen und das auf Ordner umstricken, muss ja was dazu lernen nicht immer nur stehlen.

Danke für die Zeit und Hilfe

bin mir sicher melde mich spätestens in 2 Tagen mit der nächste Hilfefrage

Gruß
Marcus
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 396
Registriert: 21. Sep 2005, 11:32

Re: Unterordner auslesen

Beitragvon wut » 08. Sep 2021, 18:25

eine Frage habe ich noch,

wenn ich im Excel mit einen Hyperlink zu einem Ordner erstelle funktioniert das wenn ich es als Web abspeichere, erstelle ich aber einen Link auf eine Datei geht es nicht?

link auf Datei ../4.4%20Prozesse%20IATF%2016949%20ISO%209001%20Prozesslandschaft/A1%20Strategie%20und%20Management/Eskalationsmatrix.xlsx
link auf Ordner ..\4.4%20Prozesse%20IATF%2016949%20ISO%209001%20Prozesslandschaft\A1%20Strategie%20und%20Management

an was kann das liegen?
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 396
Registriert: 21. Sep 2005, 11:32

Re: Unterordner auslesen

Beitragvon Nepumuk » 08. Sep 2021, 18:46

Hallo Marcus,

siehst du den Unterschied nicht? / \
De fontibus non est disputandum

Gruß
Nepumuk 8-)
Benutzeravatar
Nepumuk
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 15222
Registriert: 10. Aug 2004, 08:40
Wohnort: Regensburg

Re: Unterordner auslesen

Beitragvon wut » 08. Sep 2021, 19:13

Hallo Nepumuk

ja schon, aber wenn ich die Zeichen anpasse geht der Link zu den Dateien trotzdem nicht.

zu den Ordnern ja
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 396
Registriert: 21. Sep 2005, 11:32

Re: Unterordner auslesen

Beitragvon Nepumuk » 09. Sep 2021, 07:15

Hallo Marcus,

tut mir leid, aber ich habe keine Ahnung was da schief läuft.
De fontibus non est disputandum

Gruß
Nepumuk 8-)
Benutzeravatar
Nepumuk
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 15222
Registriert: 10. Aug 2004, 08:40
Wohnort: Regensburg

Nächste

Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: Klaus-Dieter und 32 Gäste