Prüfen, ob ein Verzeichnis valide ist.
Max
Ich habe im Netz ein sehr gutes Code-Beispiel gefunden, um Dateien in einem Ordner zu durchlaufen.
Option Explicit
' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.
' Der VB Code ist aus dem Beitrag http://www.activevb.de/tipps/vb6tipps/tipp0492.html
' Verweis: Microsoft Scripting Runtime
' Originalcode
'Dim i As Long
'With Application.FileSearch
' .NewSearch
' .LookIn = ActiveWorkbook.Path 'Suchverzeichnis
' .SearchSubFolders = False 'True wäre mit Unterverzeichnissen
' .Filename = "*.csv" 'Dateien die mit .csv änden
' .Execute 'suche ausführen
' For i = 1 To .FoundFiles.Count
' Application.StatusBar = "-->> Einlesen der Datei: " & i & " / " & .FoundFiles.Count & " ' Call importieren_und_verschieben(.FoundFiles(i))
' Next i
'End With
'
Dim LoJ As Long ' Variable für Zeile
Sub Start()
' alles Löschen außer Zeile 1
Application.ScreenUpdating = False
If ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row > 1 Then
Rows("2:" & ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row).Delete
End If
LoJ = 2
SearchInFolder ThisWorkbook.Path
Application.ScreenUpdating = True
End Sub
Private Sub SearchInFolder(ByVal Folderspec As String) ' auslesen aufrufen mit Ordnername
Dim StTyp As String ' Dateityp
Dim FSO As New FileSystemObject
Dim SearchFolder As Folder
Dim FD As Folder, FI As File
Dim EachFil As Files, EachFold As Folders
Dim LoI As Long ' Laufvariable zum schreiben der Ordner
Dim Loletzte As Long ' Variable für letzte Zeile
Dim InSpalte As Integer ' Variable für Spalte
StTyp = "xlsx"
Set SearchFolder = FSO.GetFolder(Folderspec)
Set EachFil = SearchFolder.Files ' Dateien in der jeweiligen Root
' Dateien auslesen
For Each FI In EachFil ' Schleife über alle Dateien
' Dateityp feststellen
If UCase(Right(FI.Name, Len(FI.Name) - InStrRev(FI.Name, "."))) = UCase(StTyp) Then
If UCase(Right(FI.Name, 4)) = "XLSX" Then
Workbooks.Open ThisWorkbook.Path & "\" & FI.Name
Loletzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
InSpalte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
Range(Range("A1"), Cells(Loletzte, InSpalte)).Copy ThisWorkbook.Worksheets(1). _
Cells(LoJ, 2)
With ThisWorkbook.Worksheets(1)
.Range(.Cells(LoJ, 1), .Cells(LoJ + Loletzte - 1, 1)) = ActiveWorkbook.Name
End With
LoJ = LoJ + Loletzte
ActiveWorkbook.Close False
End If
End If
Next FI
Set EachFil = Nothing
Set EachFold = Nothing
Set FSO = Nothing
End Sub
Wie kann ich diesen Fehler vorher in einer Msgbox abfangen? Die Box soll angezeigt werden, wenn es den übergebenen Ordner nicht gibt.
Hat jemand einen Tipp für mich?
Vielen Dank und viele Grüße an alle.
Max