geschenkt
10.08.2008 01:21:00
Tino
da ich etwas lange weile hatte, habe ich mal eine *.dll unter VB6 erstellt.
Diese dll soll vor allem die fehlende in Application.FileSearch in Office 2007 ersetzen,
weil es diese wie bekannt nicht mehr gibt, diese kann aber auch in anderen Versionen verwendet werden.
Damit kann man sich einiges an Codezeilen in seinem Projekt sparen.
Beispiele zur Deklarierung und Verwendung siehe Beispiele unten.
Um diese in Deinem Projekt einzubinden, gehe im VBA-Editor unter
Extras- Verweise und füge diese über Durchsuchen ein.
überprüfe nochmals die Aktivierung der FindMeFile.dll.
Ganz unten findest Du noch wie dies mit VBA erledigt werden kann,
dazu muss der Zugriff auf VBA Projekte vertraut werden.
Die Rückgabe aus der *.dll ist eine mehrdimensionale Area
Hier ein bar Beispiele zur Verwendung
Sub DemoVersion1()
'die Deklarierung
Dim objMeFile As New FindMeFile.SuchFils
'für die Rückgabe
Dim ArFile()
'sonstige Deklarierung
Dim A As Long
Application.ScreenUpdating = False
Cells.Clear
'hier erfolgt die Abfrage aus der FindMeFile.dll
'optionale Parameter müssen nicht angegeben werden.
'1. Parameter- Suchordner (String)
'2. Parameter- Suchfile (String) * als Platzhalter
'3. Parameter- Suche in Unterordner (Optional Boolean)
'4. Parameter- Sortieren nach Erstelldatum (Optional Boolean)
' dieser Parameter benögigt mehr Zeit
ArFile = objMeFile.MeExcelSuche("C:\Anwendungsdaten", "*", True, False)
'Beipiel zur Verwendung der Area
'in diesem Beispiel
'A ist die Position in der Matrix
'Die Werte 0=Pfad; 1=Dateiname; 2=Erstelldatum
If Not IsEmpty(ArFile(0, 0)) Then 'was gefunden?
For A = LBound(ArFile) To UBound(ArFile)
Cells(A + 1, 1) = ArFile(A, 0) 'Pfad
Cells(A + 1, 2) = ArFile(A, 1) 'Datei
Cells(A + 1, 3) = ArFile(A, 2) 'Datum Erstellt
Next A
End If
Application.ScreenUpdating = True
End Sub
Sub DemoVersion2() 'Beschreibung siehe Version1
Dim objMeFile As Object
Dim ArFile()
Dim A As Long
Set objMeFile = CreateObject("FindMeFile.SuchFils")
Application.ScreenUpdating = False
Cells.Clear
ArFile = objMeFile.MeExcelSuche("C:\Anwendungsdaten\", "*", True, True)
If Not IsEmpty(ArFile(0, 0)) Then
For A = LBound(ArFile) To UBound(ArFile)
Cells(A + 1, 1) = ArFile(A, 0) 'Pfad
Cells(A + 1, 2) = ArFile(A, 1) 'Datei
Cells(A + 1, 3) = ArFile(A, 2) 'Datum Erstellt
Next A
End If
Application.ScreenUpdating = True
Set objMeFile = Nothing
End Sub
'Registrierung der FindFile.dll mit VBA,
'Zugriff auf VBA Projekte muss vertraut werden
Sub regestrieren()
Dim DllPath As String
DllPath = _
IIf(Right$(ThisWorkbook.Path, 1) = "\", _
ThisWorkbook.Path & "FindFile.dll", _
ThisWorkbook.Path & "\FindFile.dll")
Shell "regsvr32 /s " & Chr(34) & DllPath & Chr(34)
ThisWorkbook.VBProject.references.AddFromFile (DllPath)
End Sub
Sub deregistrieren()
Dim DllPath As String
DllPath = _
IIf(Right$(ThisWorkbook.Path, 1) = "\", _
ThisWorkbook.Path & "FindFile.dll", _
ThisWorkbook.Path & "\FindFile.dll")
On Error Resume Next
ThisWorkbook.VBProject.references.Remove _
ThisWorkbook.VBProject.references("FindMeFile")
Shell "regsvr32 /s /u " & Chr(34) & DllPath & Chr(34)
End Sub
Hier die FindFile.dll als *.zip
https://www.herber.de/bbs/user/54476.zip
Viel Spaß damit.
PS: über eine Rückmeldung würde ich mich freuen.
Gruß Tino