AW: Pfad Lesen
29.09.2015 10:11:59
Jens
Hallo zusammen,
ich habe nun etwas gefunden, bin aber noch nicht ganz zufrieden und hoffe ihr könnt mir helfen..
Mit dem Macro kann ich einen Ordner auswählen und diesen dann auslesen lassen. Die Ordnerauswahl funktioniert jedoch über ein Fenster. Ich möchte aber nicht über dieses Fenster den Ordner wählen sondern den Ordner fest im Macro intigriert haben.
Auch bekomme ich eine Fehlermeldung wenn ich keinen Ordner auswähe und auf Abbrechen gehe..
Grüße
Jens
Option Explicit
Private strList() As String
Private lngCount As Long
Private sPfad As String
Public Sub DateienAuflisten()
'----------------------------------------------------------------------------------------------- _
' Module: modDateienInOrdnerAuslesen
' Datum: 28.05.2013
' Author: Lukas Rohr | ExcelNova.org
' Funktion: Listed alle Excel Dateien auf welche sich in der Ausgewählten Ordnerstruktur _
befinden inklusive
' aller Subordner. Es erstellt eine Liste der Dateien mit Angabe des Ordner Pfades _
und einem Link
' der Direkt mit der Datei verknüpft ist.
'----------------------------------------------------------------------------------------------- _
Dim i As Long
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
OrdnerAuswählen
lngCount = 0
SearchFiles sPfad, "*.xl*"
' Error Message incase no Files of the chosen Filetype are found
If lngCount = 0 Then
MsgBox "Es wurde in der Ordnerstruktur" & sPfad & " keine Dateien gefunden!"
Exit Sub
End If
With ThisWorkbook
On Error Resume Next
.Worksheets("Datei Übersicht").Delete
On Error GoTo 0
.Worksheets.Add(After:=Worksheets(ThisWorkbook.Worksheets.Count)).Name = "Datei Übersicht"
End With
With ActiveSheet
.Range(.Cells(1, 1), .Cells(lngCount, 2)) = _
WorksheetFunction.Transpose(strList)
' Löscht den SuchOrdner Pfad der Datei da dieser immer gleich ist
.Range(.Cells(1, 2), .Cells(lngCount, 2)).Replace What:=sPfad & "\", Replacement:="", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
' Hyperlinkverknüpfung erstellen mit den Dateien
For i = 0 To lngCount - 1
With .Cells(i + 1, 1)
.Select
.Cells(i + 1, 1).Hyperlinks.Add Anchor:=Selection, Address:=strList(1, i), _
TextToDisplay:=strList(0, i)
End With
Next i
' Leichte Formatierung des Berichtes
.Range("A:A").EntireColumn.AutoFit
.Rows(1).Insert
With Range(Cells(1, 1), Cells(1, 2))
.Value = Array("Datei Pfad", "Datei Name")
.Font.Bold = True
.Interior.PatternColorIndex = xlAutomatic
.Cells.Interior.ThemeColor = xlThemeColorAccent1
End With
End With
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
End Sub
Private Sub OrdnerAuswählen()
' Ruft Dialogfenster zum Ordner Auswählen auf
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & " \"
.Title = "Bitte Ordner wählen"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
sPfad = .SelectedItems(1)
End With
End Sub
Private Sub SearchFiles(strFolder As String, strFileName As String)
Dim objFolder As Object
Dim objFile As Object
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(strFolder).Files
If objFile.Name Like strFileName Then
ReDim Preserve strList(0 To 1, lngCount)
strList(0, lngCount) = objFile.Name
strList(1, lngCount) = objFile.Path
lngCount = lngCount + 1
End If
Next
For Each objFolder In objFSO.GetFolder(strFolder).Subfolders
SearchFiles strFolder & "\" & objFolder.Name, strFileName
Next
End Sub