Anzeige
Archiv - Navigation
1068to1072
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

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
Anzeige
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

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige