alternative für Application.FileSearch

Question

Hallo zusammen,

ich zerbreche mir gerade den Kopf, wie ich folgendes Programm umschreiben kann, dass es auch unter office 2007 läuft. Sicherlich könnt ihr mir helfen;) Das Programm lautet folgender Maßen:
Sub Einlesen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
Dim zeile As Long
With Application.FileSearch
.NewSearch
.LookIn = ActiveWorkbook.Path
.Filename = "*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
If DateiName <> ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien)
zeile = ThisWorkbook.Sheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1
Workbooks(DateiName).Sheets(1).Range("B5:B110").Copy
ThisWorkbook.Sheets(1).Range("A" & zeile).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Workbooks(DateiName).Close
End If
Next Dateien
End If
End With
Call EventsOn
Call DoppelteNr
End Sub



Das großr Problem ist "Application.Filesearch", das nicht unterstützt wird. Ich danke euch schon jetzt.

Mit freundlichen Grüßen
Matthias

Answer 1

Hallo,

schau mal hier nach, da wurde das Thema bereits mal abgehandelt.

Wobei, wenn ich mir den Code so ansehe, gehe ich mal davon aus, des es sich bei dem Fragesteller im oberen Link und Dir um die gleiche Person handelt.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 2

Hallo Oliver,

danke für deinen Link. Ich habe aber nichts mit dieser Anfrage zu tun gehabt. Werde jetzt einmal versuchen es zum Laufen zu bringen.

Matthias

Answer 3

hi all ^^

wie gewuenscht

gruss nighty

Option Explicit
Sub DateienLesen()
Call EventsOff
Dim DateiName As String
Dim Zeile As Long
DateiName = Dir(ActiveWorkbook.Path & "\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp1\" & DateiName
Zeile = ThisWorkbook.Sheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1
Workbooks(DateiName).Sheets(1).Range("B5:B110").Copy
ThisWorkbook.Sheets(1).Range("A" & Zeile).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Workbooks(DateiName).Close
End If
DateiName = Dir
Loop
Call EventsOn
Call DoppelteNr
End Sub

Answer 4

Hallo nighty,

danke für deine schnelle Antwort. Ich habs gleich ausprobiert, aber jetzt meint er "Fehler beim Kompilieren: Sub odr Func nicht festgelegt"
Ich weiß nicht was ich machen soll..


Wäre dir echt dankbar, wenn du kurz auf das Problem eingehen köntest. Oder schick mir einfach eine Exceldatei, in die diese Procedur eingbaut ist.

Vielen Dank

Matthias (mathematik07(at)web.de)

Answer 5

Hallo Mathias,

welche Zeile wird denn bei Dir markiert, wenn der Fehler auftritt? Ich gehe mal davon aus, dass es eine der nachfolgenden 3 Zeilen im Makro sein werden:

Call EventsOff

oder

Call EventsOn

oder

Call DoppelteNr

Wenn dem so ist, hast Du denn ein Makro, welches den Namen der markierten Zeile trägt? Das Makro, welches Du in Deiner Frage gestellt hast, lief das schon mal bei Dir ohne Fehler und die Fehler treten erst jetzt bei Excel 2007 auf?

Du musst schon etwas mehr schreiben, denn wir alle hier sind keine Hellseher.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 6

Hallo Oliver,

bei der Fehlermeldung wird "Sub DateienLesen()" gelb markiert. Meine erste Version von diesem Programm ist beim 2003 gut gelaufen.

MfG
Matthias

Answer 7

Hallo Matthias

dann benötigt man Deine Datei um den Fehler zu finden. Lade diese z.B. bei http://www.file-upload.net/ ]hoch und teile uns den Link, den Du erhälst, hier mit.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]