Suchfunktion

Forumthread: Suchfunktion

Suchfunktion

28.04.2009 14:28:03

Dan

Hallo Zusammen,
Ich nutze unter Excel2003 folgendes Modul:


Sub finfo()
Dim FNR As String
Set fs = Application.FileSearch
FNR = Worksheets("Fonds").Range("D9")
With fs
.LookIn = "X:\Blatt"
.SearchSubFolders = True
.Filename = "" & FNR & "*.xls"
If .Execute > 0 Then
MsgBox "Es wurde " & .FoundFiles.Count & _
"Datei(n) gefunden."
For i = 1 To .FoundFiles.Count
'MsgBox .FoundFiles(i)
Workbooks.Open "" & .FoundFiles(i) & ""
ActiveWorkbook.RunAutoMacros xlAutoOpen
Next i
Else
MsgBox "Es wurden keine Dateien gefunden"
End If
End With
End Sub

Leider muss ich nun Excel2007 nutzen und dort gibt es die Funktion "Filesearch" nicht.
Wie muss ich die Zeile
Set fs = Application.FileSearch
abändern das es unter Excel2007 funktioniert? Danke für Eure Hilfe.
Gruss

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Suchfunktion

28.04.2009 14:37:48

Hajo_Zi
AW: Suchfunktion

28.04.2009 14:39:41

Dan
AW: Suchfunktion

29.04.2009 09:04:59

Dan
mit FileSystemObject

29.04.2009 09:34:27

Tino

AW: Suchfunktion

28.04.2009 14:37:48

Hajo_Zi

Hallo Dan,
schaue hier.
http://hajo-excel.de/2007_hinweise.htm

AW: Suchfunktion

28.04.2009 14:39:41

Dan

Das hilft mir leider alles nicht weiter, bzw komme ich nicht
weiter. Das hatte ich mir schon mal angeguckt ... sorry
kann mir jemand anderes weiterhelfen`?

AW: Suchfunktion

29.04.2009 09:04:59

Dan

Kann mir denn hier niemand helfen wie ich mein quelltext umschreibe?
die lösung von hajo hilft mir leider nicht weiter bzw. ich kann es nicht adaptieren
vielen dank

mit FileSystemObject

29.04.2009 09:34:27

Tino

Hallo,
teste mal diesen Code

Sub Test_Oeffne_ExcelFile()
Dim FileArea()
Dim LCount As Long
Dim FNR As String

FNR = Worksheets("Fonds").Range("D9")

    '1.Parameter Area 
    '2.Parameter Ordner, wo soll gesucht werden? 
    '3.Parameter Datei,* als Platzhalter verwenden,Optional leer ist alle 
    '4.Parameter mit Unterordner = True, Optional False ist ohne 
    '5.Parameter Counter 
ListFilesInFolder FileArea, "J:\1 Forum", FNR & "*.xls", True, LCount '"X:\Blatt" 


    If LCount > 0 Then
     For LCount = Lbound(FileArea) To Ubound(FileArea)
        Workbooks.Open FileArea(LCount)
        ActiveWorkbook.RunAutoMacros xlAutoOpen
     Next LCount
    End If

Erase FileArea
End Sub

Sub ListFilesInFolder(FileArea, SourceFolderName As String, Optional DateiFormat As String = "*.*", _
                        Optional IncludeSubfolders As Boolean = False, Optional LCount As Long = 0)

Dim FSO As Object, SourceFolder As Object, SubFolder As Object
Dim FileItem
Dim Status As Integer
 
 Set FSO = CreateObject("Scripting.FileSystemObject")
 
 If FSO.FolderExists(SourceFolderName) Then
     Set SourceFolder = FSO.GetFolder(SourceFolderName)
            
        On Error GoTo Err_Zugriff: 'sollte Ordner geschützt sein 
         
        For Each FileItem In SourceFolder.Files
            If LCase(FileItem) Like LCase(DateiFormat) Then
             Redim Preserve FileArea(LCount)
             FileArea(LCount) = FileItem
             LCount = LCount + 1
            End If
        Next FileItem
    
    
        If IncludeSubfolders Then
            For Each SubFolder In SourceFolder.SubFolders
                ListFilesInFolder FileArea, SubFolder.Path, DateiFormat, IncludeSubfolders, LCount
            Next SubFolder
        End If
 Else
       MsgBox "Ordner nicht gefunden!", vbCritical
 End If

Err_Zugriff:
Set FileItem = Nothing: Set SourceFolder = Nothing: Set FSO = Nothing
End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

Forumthread: Suchfunktion

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread