Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Inhaltsverzeichnis mit Link

Betrifft: Inhaltsverzeichnis mit Link von: Ulrich
Geschrieben am: 10.09.2020 14:14:34

Hallo zusammen,

ich möchte gerne in einer Exceldatei „Inhaltsverzeichnis“ aus dem aktuellen Ordner oder aus Unterordner die Namen der vorhandenen Dateien in 4 Spalten aufgelistet haben.

Spalte B (Dateinamen die mit GB_ beginnen)

Spalte E (Dateinamen die mit BA_ beginnen)

Spalte H (Dateinamen die mit BG_ beginnen)

Spalte K (Dateinamen die mit XX_ beginnen)

die sollten Alphabetisch sortiert mit „Dateiname und Verlinkung zur Datei“ aufgelistet werden.

Die Dateien können Excel, Word oder auch pdf sein.

Hat vielleicht jemand eine Lösung für mich?
eine allgemeine Auflistung bekomme ich hin, aber mit der gewünschten Sortierung und einem zusätzlichen Link nicht.

Danke für eure Hilfe.

Gruß Ulli

Vielen Dank vorab.

Gruß Ulli

https://www.herber.de/bbs/user/140173.xlsx

Betrifft: AW: in einer Kombination von PQ & HYPERLINK() ...
von: neopa C
Geschrieben am: 10.09.2020 14:27:06

Hallo Ulli,

... sollte das realisierbar sein. Mehr zu PQ (PowerQuery) findest Du, wenn Du mal danach googelst. Zur Funktion HYPELINK() sieh die MSO-Hilfe


Gruß Werner
.. , - ...

Betrifft: AW: Inhaltsverzeichnis mit Link
von: UweD
Geschrieben am: 10.09.2020 15:23:26

Hallo

versuch es mal damit

Sub alle_Dateien_Verzeichnis() '
    On Error GoTo Fehler
    Dim Pfad As String, Ext1 As String, Ext2 As String, Ext3 As String
    Dim Datei As String, Spalte As Integer, LR As Integer
    Dim ArrSp, Z1 As Integer, i As Integer, RNG As Range
    
    Pfad = "E:\Excel\Temp\" '**** mit \
    Ext1 = ".xls"
    Ext2 = ".doc"
    Ext3 = ".pdf"
    
    ArrSp = Array(1, 4, 7, 10) ' Zielspalten für die unterschiedlichen Dateinamen
                               ' Array beginnt bei 0
    
    Z1 = 4 'erste Zeile mit Daten
    
    With Sheets("Tabelle1")
    
        'reset
        With .UsedRange.Offset(Z1 - 1)
            .ClearContents
            .Hyperlinks.Delete
        End With
    
        Datei = Dir(Pfad & "*.*")
        Do While Len(Datei) > 0
            'Nur xls,doc und pdf
            If InStr(Datei, Ext1) > 0 Or InStr(Datei, Ext2) > 0 Or InStr(Datei, Ext3) > 0 Then
                Select Case Left(Datei, 2) 'ersten 2 Zeichen von Dateiname
                    Case "GB"
                        Spalte = ArrSp(0)
                    Case "BA"
                        Spalte = ArrSp(1)
                    Case "BG"
                        Spalte = ArrSp(2)
                    Case "XX"
                        Spalte = ArrSp(3)
                        
                    Case Else
                        Spalte = 0
                End Select
            
                If Spalte > 0 Then
                    LR = .Cells(.Rows.Count, Spalte).End(xlUp).Row + 1 'erste Freie Zeile der  _
Spalte
                
                    .Cells(LR, Spalte) = WorksheetFunction.Max(.Columns(Spalte)) + 1 '  _
Nummerierung eintragen
                    .Cells(LR, Spalte + 1) = Datei ' Dateiname eintragen
                    .Hyperlinks.Add Anchor:=.Cells(LR, Spalte + 1), _
                        Address:=Pfad & Datei, TextToDisplay:=Datei

                    
                    
                End If
            End If
            Datei = Dir() ' nächste Datei
        Loop
        
        For i = 0 To 3 ' Sortieren
            LR = .Cells(.Rows.Count, ArrSp(i)).End(xlUp).Row
            Set RNG = .Cells(Z1, ArrSp(i) + 1).Resize(LR - Z1 + 1, 1)
            
            With .Sort
                .SortFields.Clear
                .SortFields.Add2 Key:=RNG, SortOn:=xlSortOnValues, _
                    Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange RNG
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        Next
    End With
    
    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear

End Sub

LG UweD

Beiträge aus dem Excel-Forum zum Thema "Inhaltsverzeichnis mit Link"