Filesearch unter Excel 2007

Question

Guten morgen,

ich hätte da mal eine Fage.
Kann mir jemand viell helfen im Bezug auf Filesearch in Ecxel 2007?
Was ist denn der beste Ersatz dafür?
Ich habe in meinem Fall eien Ordner mit Exceltabellen, ich lasse jede Date öffnen und kopiere mir den Inhalt eines Tabellenblattes in meine DAtei rein.

Hier mal mein Code:

Dim Dateien As Integer
Dim DateiName As String
With Application.FileSearch

.NewSearch
.LookIn = "H:\CCO\ALLG\frontlineshop KIK\"
.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)
'Das wäre der Teil der auszuführen wäre
ActiveSheet.Unprotect ("admin")
Workbooks(DateiName).Worksheets("Tabelle3").Range(Workbooks(DateiName).Worksheets("Tabelle3").Cells(2, 1), Workbooks(DateiName).Worksheets("Tabelle3").Cells(Workbooks(DateiName).Worksheets("Tabelle3").UsedRange.SpecialCells(xlCellTypeLastCell).Row, Workbooks(DateiName).Worksheets("Tabelle3").UsedRange.SpecialCells(xlCellTypeLastCell).Column)).Copy ThisWorkbook.Worksheets("Tabelle1").Range("A" & ThisWorkbook.Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Workbooks(DateiName).Close SaveChanges:=True
End If
Next Dateien
End If
End With

Vielen Dank schon mal im Voraus für Eure Hilfe.

Gruß
morpheus

Answer 1

Hallo,

Kann mir jemand viell helfen im Bezug auf Filesearch in Ecxel 2007?
Was ist denn der beste Ersatz dafür?

Ich weiß nicht, ob es da eine Ersatz gibt, der einzige Unterschied sind wahrscheinlich die 4-stelligen Dateiendungen in Excel 2007 (*.xlsx, *.xlsm
usw.)

Gruß
Rainer

Answer 2

Hallo Rainer,

vielen Dank schon mal für den Tip.
Daran kann es aber erstmals nicht liegen, da ich im moment sowieso noch mit "alten" .xls Datei arbeite.

Habe hier mal was versucht.

mein Code:

Dim DateiName As String
Dim objFSO As Object
Dim objOrdner As Object
Dim objDatei As Object
Dim objDateien As Object
Dim strDatei As String
Dim strOrdner As String
Set objFSO = CreateObject("Scripting.FileSystemObject")
strOrdner = "C:...."
Set objOrdner = objFSO.GetFolder(strOrdner)
Set objDateien = objOrdner.Files
For Each objDatei In objDateien

strDatei = DateiName(objDatei.Name)
Workbooks.Open Filename:=strDatei

ActiveSheet.Unprotect ("admin")
Workbooks(strDatei).Worksheets("Tabelle3").Range(Workbooks(strDatei).Worksheets("Tabelle3").Cells(2, 1), Workbooks(strDatei).Worksheets("Tabelle3").Cells(Workbooks(strDatei).Worksheets("Tabelle3").UsedRange.SpecialCells(xlCellTypeLastCell).Row, Workbooks(strDatei).Worksheets("Tabelle3").UsedRange.SpecialCells(xlCellTypeLastCell).Column)).Copy ThisWorkbook.Worksheets("Tabelle1").Range("A" & ThisWorkbook.Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Workbooks(strDatei).Close SaveChanges:=True

Next

Allerdings markiert mit Excel hier dann das DateiName in der Zeile
strDatei = DateiName(ojbDatei.Name) und schreib

Erwartet:Datenfeld.

Wo liegt hier der Fehler?

Vielen DAnk und schon mal ein schönes Wochenende.

Gruß
morpheus

Answer 3

Hallo ,

die Zeile, die bei Dir einen Fehler produziert lautet richtig:

strDatei = objDatei.NameDie Eigenschaft "Application.FileSearch" gibt es bei Excel2007 nicht mehr.
Da musst Du Dir eine neue Klasse generieren, die das was "Application.FileSearch" bis Excel2003" gemacht hat, nachbildet. Ich habe sowetwas mal in einem Programm von mir gemacht. Bei Bedarf kann ich mal eine Beispieldatei erstellen und die Datei auf meinen Server hochladen

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 4

Hallo,

Application.FileSearch gibt es unter 2007 nicht mehr. Schaue hier
http://hajo-excel.de/2007_hinweise.htm

Gruß Hajo

Answer 5

hi all ^^

die einfachste methode

gruss nighty

Option Explicit
Sub DateienLesen()
Dim DateiName As String
DateiName = Dir("C:\Temp1\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp1\" & DateiName
Rem weiterer code
Workbooks(DateiName).Close
End If
DateiName = Dir
Loop
End Sub

Answer 6

hi morpheus__85 ^^

angepasster code :-)

gruss nighty

Option Explicit
Sub DateienLesen()
Dim DateiName As String
DateiName = Dir("C:\Temp1\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp1\" & DateiName
ActiveSheet.Unprotect ("admin")
Workbooks(DateiName).Worksheets("Tabelle3").Range(Workbooks(DateiName).Worksheets("Tabelle3").Cells(2, 1), Workbooks(DateiName).Worksheets("Tabelle3").Cells(Workbooks(DateiName).Worksheets("Tabelle3").UsedRange.SpecialCells(xlCellTypeLastCell).Row, Workbooks(DateiName).Worksheets("Tabelle3").UsedRange.SpecialCells(xlCellTypeLastCell).Column)).Copy _
ThisWorkbook.Worksheets("Tabelle1").Range("A" & ThisWorkbook.Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Workbooks(DateiName).Close SaveChanges:=True
End If
DateiName = Dir
Loop
End Sub

Answer 7

hi

protection und pfad noch anpassen :-)

gruss nighty