Office: Ordner nach Dateien durchsuchen und als Tabellenblatt öffnen

jimmcguinn · 27. August 2012

Hallo liebe Office-Gemeinde,

gibt es eine Möglichkeit einen Ordner und dessen Unterordner nach .xls Dateien zu durchsuchen, dessen ersten vier Zeichen des Dateinamens gleichs sind und diese als neues Tabellenblatt zu der geöffnetet Mappe hinzuzufügen?

Wenn ich z.B. in eine Inputbox 2390 schreibe, öffnet er alle Dateien als jeweils neues Tabellenblatt, dessen Dateiname mit 2390 anfangen.

Wenn ich z.B. 2220 eingebe, werden alle Dateien des Ordners und der Unterordner als neues Tabellenblatt hinzugefügt, die mit 2220 im Dateinamen beginnen.

Ich bedanke mich für eure Ideen!

:)

chris-kaiser · 28. August 2012

Hi

Alles geht immer irgendwie *wink.gif*

Aber ich verstehe das hier nicht ?

öffnet er alle Dateien als jeweils neues Tabellenblatt, ....
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

was ist damit gemeint?

Dateien öffnen als neues Tabellenblatt?

jimmcguinn · 28. August 2012

Hallo chris,

danke für die fixe Antwort.

Ich führe das Makro beispielsweise in der Datei "Dashboard" aus und jede gefundene xls. Datei sollte als neues Tabellenblatt (sheet) hinzugefügt werden.

Ich hoffe ich konnte mich damit unmissverständlicher ausdrücken?

chris-kaiser · 28. August 2012

Hi

Ist für mich noch nicht klar. ...

Eine Datei kann nicht als Sheet(Blatt, Tabellenblatt, Register, Blattregister...) eingefügt werden!

folgendes könnte sein

Soll ein leeres Tabellenblatt eingefügt werden mit dem Namen der Datei?

oder ist in den zu suchenden Mappen nur ein Tabellenblatt, dass in die ausführende Mappe kopiert werden sollte?

oder soll das erste (letzte, zweite oder welches auch immer) Tabellenblatt der gef. Datei in die aufrufende Mappe eingefügt werden.

oder soll ein Tabellenblatt erzeugt werden wo z.B in der Zelle A1 der Name der Datei steht?

oder....

jimmcguinn · 28. August 2012

Moin,

du hast ja recht. Also:

die zu suchenden Mappen haben nur ein Tabellenblatt, welches in die ausführende Mappe kopiert werden sollte.

chris-kaiser · 28. August 2012

hi

Code:

Option Explicit
Dim fs As Object, First As Integer
Sub such_Mich()
Dim objShell As Object
Dim BrowseDir
Dim strVerzeichnis As String
Set objShell = CreateObject("Shell.Application")
Set BrowseDir = objShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
strVerzeichnis = BrowseDir.Items().Item().Path
If strVerzeichnis = "" Then: On Error GoTo 0: Exit Sub
Set fs = CreateObject("Scripting.FileSystemObject")
First = 1
Dim StrSearch As String
Do
StrSearch = InputBox("geben sie die ersten 4 Zeichen der gesuchten Dateien ein", "Such mich")
Loop While StrSearch = "" Or Len(StrSearch) 4
ffile strVerzeichnis, StrSearch, 1
End Sub
Sub ffile(strVerzeichnis As String, StrSearch As String, First)

Dim MyFolder As Object, FSO As Object, StrName As String, IntC As Integer, strPath As String
Set FSO = fs.GetFolder(strVerzeichnis)
For Each MyFolder In FSO.SubFolders
For IntC = 0 To First
If First = 1 Then
strPath = strVerzeichnis
Else
strPath = MyFolder
End If
StrName = Dir(strPath & "\" & StrSearch & "*.xls")
Do While StrName > ""
If StrName ThisWorkbook.Name Then
On Error GoTo errhandler
Dim objWb As Object
Dim objSH As Object
Dim AktuelleMappe As Workbook
Set AktuelleMappe = ActiveWorkbook
Set objWb = GetObject(strPath & "\" & StrName)
Set objSH = objWb.Sheets(1)
objSH.Copy Before:=AktuelleMappe.Sheets(1)
objWb.Close savechanges:=False

Set objSH = Nothing
Set objWb = Nothing

End If
StrName = Dir
Loop
Next
If FSO.SubFolders.Count > 0 Then
ffile strPath & "\", StrSearch, 0
End If
Next
Exit Sub
errhandler:
MsgBox "Fehlernr:" & Err.Number & " " & Err.Description
objWb.Close savechanges:=False
Set objSH = Nothing
Set objWb = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mal schauen *wink.gif*

jimmcguinn · 28. August 2012

Hallo chris!

super! Funktioniert tadellos! Das hilft mir wirklich ungemein, ich danke dir!
Ich werde mir den Code nun genauer ansehen um zu lernen zukünftig vielleicht selbst auf so eine Lösung zu kommen.

Einen schönen Tag wünsche ich!

jimmcguinn · 12. September 2012

Hallo chris und restliches forum,

ich erlaube mir hier nochmal einzuhaken.

Ist es auch möglich den Code so umzubauen, dass ich die Suchkriterien nicht per Hand eingebe, sondern diese in einer externen Excel "Hilfsdatei" stehen. Das Makro würde dann alle für jedes Suchkriterium eine Suche starten.

Es stünde in der Hilfsdatei im ersten und einzigen Tabellenblatt in
A1: 0001
A2: 0002
usw.

Ich hoffe ich konnte mich unmissverständlich ausdrücken *Smilie

Office: Ordner nach Dateien durchsuchen und als Tabellenblatt öffnen

Ordner nach Dateien durchsuchen und als Tabellenblatt öffnen

Ordner nach Dateien durchsuchen und als Tabellenblatt öffnen

Ordner nach Dateien durchsuchen und als Tabellenblatt öffnen

Ordner nach Dateien durchsuchen und als Tabellenblatt öffnen

Ordner nach Dateien durchsuchen und als Tabellenblatt öffnen - Similar Threads - Ordner Dateien durchsuchen

Nach einer Datei suchen in mehreren Ordnern?

Datei in mehreren Ordnern suchen und wenn gefunden öffnen?! Macro / VBA

Excel Datei an einen Ordner binden

Backup Ordner anlegen und Datei speichern in One Drive

Ordner durchsuchen , Dateien aussuchen und Dateien verschieben

Ordner rekursiv nach Dateien durchsuchen & Dateien öffnen

Auf Datein/Ordner im Teams-Chat verweisen (z.B. mit @"Datei")