Dateien mit VBA öffnen

Hallo Claus,

kleine Änderung. Denn die Aufgabe des Zählens der Dateien sowie das öffnen war nur ein Bestandteil dessen, was schlussendlich die ganze Aufgabe darstellt. Für alles auf einmal bin ich noch nicht weit genug, daher Schritt für Schritt zum Ziel vorarbeiten.

Ich habe nun die weitere Funktion bis zu der Stelle am laufen, wo das zählen und öffnen der Dateien ins Spiel kommt. Die Dateien müssen gezählt werden, da alle geöffnet werden sollen/müssen. Nur, und das ist die kleine Änderung, nicht mehr auf einmal sondern
nacheinander. Also von der Reihenfolge her.

1. Dateien zählen
2. Erste gefundene/gezählte Datei öffnen
3. Aufgabe, die mit den gezählten Dateien einher gehen, ausführen
4. Erste gefundene/gezählte Datei schließen
5. Zweite gefundene/gezählte Datei öffnen
6. ….

Leider funktioniert bei mir Workbooks.Open an der Stelle, an der ich es platziert hatte, nicht. Von meinem Verständnis her habe ich es direkt vor Loop platziert - also den For i = LBound …-Block erstmal aus kommentiert. Kannst Du mir nochmal deine Hilfe
zu Teil werden lassen? Wäre echt nett.

Okay, dann lad Dir mal diese Datei runter:

https://www.dropbox.com/s/700hbz18bsc7nu2/FileSearch.cls?dl=1

Öffne den VBA Editor und importiere die Datei (Datei \ Datei importieren)

Erstelle ein reguläres Modul (Einfügen \ Modul)

Und da kopierst Du den Code unten rein.

Das FileSearch-Objekt gab es mal in Office und wurde vor etlichen Jahren aus Kompatiblitätsgrunden zu anderen Plattformen (z.B. Mac) entfernt.

Mit dem Ding kannst Du z.B. auch Dein Windows-Verzeichnis durchsuchen (... falls Du Zugriff darauf hast). Mit VBA.Dir oder Scripting.FileSystemObject fällt man dort auf die Nase.

Andreas.

Option Explicit

Sub Test()

  Dim FS As New FileSearch

  Dim FullName, FName

  Dim Wb As Workbook

  

  With FS

    'Wo suchen

    .LookIn = ThisWorkbook.Path

    'Was suchen

    .FileName = "*.xls*"

    'Unterverzeichnisse?

    .SearchSubFolders = True

    'Ausführen

    .Execute

    

    'FoundFiles ist eine Collection mit allen gefundenen Dateien

    If .FoundFiles.Count = 0 Then

      MsgBox "Keine Dateien gefunden"

      Exit Sub

    End If

    

    'Anmerkung:

    '  In der Collection sind die vollständigen Pfade, nicht nur Dateinamen

    For Each FullName In .FoundFiles

      'Der reine Dateiname geht so

      FName = Mid$(FullName, InStrRev(FullName, "\") + 1)

      'Ein ~ zeigt das diese in Excel geöffnet ist

      If Left$(FName, 1) = "~" Then GoTo Skip

      'Das sind wir selber:

      If FName = ThisWorkbook.Name Then GoTo Skip

      'Die könn(t)en wir öffnen

      Set Wb = Workbooks.Open(FullName)

Skip:

    Next

  End With

End Sub

Hallo Claus.

Danke erstmal. Nun Fast. Von den drei Testdateien werden zwei und drei geöffnet. Nur die erste nicht. Und vielleicht kannst Du mir einen Fehler bezüglich des fehlenden \ erklären.

In meinem schlauen Büchlein steht das tatsächlich so.

strPfad = ThisWorkbook.PathstrMappe = Dir(strPfad & "\*.xls*")
Nun. Wenn ich deinen Code übernehme, funktioniert das tatsächlich nicht, wenn das \ in der strMappe-Zeile steht. Das muss scheinbar in der strPfad-Zeile stehen. Zumindest in diesem Zusammenhang. Rein die Zählfunktion hatte damit
 funktioniert. Das mit dem \ scheint etwas tricky zu sein.

Hallo,

probiere es mit dem FileSystemObject:

Sub DateienZaehlen()
Dim FSO As Object, objFolder As Object, objFile As Object
Dim myPath As String
Dim i As Integer

myPath = ThisWorkbook.Path & "\"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.getfolder(myPath)
Set objFile = objFolder.Files

For Each objFile In objFolder.Files
If InStr(objFile.Name, ".xls") And objFile.Name <> "~$" & ThisWorkbook.Name Then
Workbooks.Open (myPath & objFile.Name)
i = i + 1
End If
Next
MsgBox "Es wurden " & i & " Mappen ge?ffnet"
End Sub

Claus

Hallo Andreas,

um beides. Zu allerst geht es um wirkliche Anwendung. Das sekundäre Ziel ist aber natürlich auch, etwas dabei zu lernen.