Home VBA Makro Beispiele Sonstige Codes VBA - Dateinamen auflisten
VBA - Dateinamen auflisten PDF Drucken E-Mail
Geschrieben von: Marcus Rose   
Sonntag, 11. September 2011 um 18:44 Uhr

Ich hatte den Wunsch mir sämtliche Excel Beispiele, welche ich besitze, in einer Excel Tabelle auflisten zu lassen. Dafür habe ich mir folgendes Excel Makro geschrieben:


Sub Dateinmen_auflisten() Dim x As Integer Dim strGef As Long Dim strPfad As String strPfad = "c:\Excel\Excel\" Application.ScreenUpdating = False UsedRange.Clear With Application.FileSearch .LookIn = strPfad .FileType = msoFileTypeExcelWorkbooks .Execute x = .FoundFiles.Count For strGef = 1 To x Cells(strGef, 1) = .FoundFiles(strGef) Next End With Application.ScreenUpdating = True End Sub

 

Da ich viele Excel Beispiele besitze und diese auch teilweise für Forumsarbeiten benötige, habe ich mir, damit es schneller geht, dieses Makro noch so umgebaut, dass Hyperlinks ins Tabellenblatt integriert werden. das ging mit recht wenig Aufwand. Das Makro sieht dann so aus:

 

Sub Dateinmen_auflisten()
Dim x As Integer
Dim strGef As Long
Dim strPfad As String
strPfad = "c:\Excel\Excel\"
Application.ScreenUpdating = False
UsedRange.Clear
With Application.FileSearch
    .LookIn = strPfad
    .FileType = msoFileTypeExcelWorkbooks
    .Execute
    x = .FoundFiles.Count
        For strGef = 1 To x
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(strGef, 1), Address:= _
            .FoundFiles(strGef), TextToDisplay:= _
            .FoundFiles(strGef)
        Next
End With
Application.ScreenUpdating = True
End Sub

 

Leider funktioniert dieses Makro nur bis Excel 2003. Ab der Excel Version 2007 gibt es nicht mehr den Befehl Application.Filesearch. Hier musste ich jetzt selber in einem Forum nachfragen, wie man jetzt vorgehen sollte. Die Version, welche ich jetzt nenne funktioniert nicht nur ab Version 2007, sondern auch mit Excel 2003:

 

Sub Dateinamen_auflisten()
Dim FSO As Object
Dim strPfad As String
Dim x As Integer
Dim strGef As Object
Application.ScreenUpdating = False
strPfad = "c:\Excel\Excel\"
ActiveSheet.UsedRange.Clear
Set FSO = CreateObject("Scripting.FilesystemObject")
For Each strGef In FSO.getfolder(strPfad).Files
  Select Case LCase(FSO.getextensionname(strGef))
    Case "xls", "xla", "xlsm", "xlsx"
    x = x + 1
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(x, 1), Address:= _
    strGef, TextToDisplay:=strGef.Name
  End Select
Next
Application.ScreenUpdating = True
End Sub
Zuletzt aktualisiert am Sonntag, 11. September 2011 um 19:49 Uhr
 
Copyright © 2013 ms-excel.eu. Alle Rechte vorbehalten.
 

Autoren - Login

Werbung

wichtige Links:
http://ms-excel.eu
Hier habt Ihr eine gute Excel Hilfe
Besucherstatistik
Besucher gesamt: 2.330.893
Besucher heute: 181
Besucher gestern: 1.264
Max. Besucher pro Tag: 4.488
gerade online: 7
max. online: 356
counter Statistiken