Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Schnelle Dateisuche in Unterordnern incl.

Betrifft: Schnelle Dateisuche in Unterordnern incl. von: chris b
Geschrieben am: 02.09.2004 13:34:30

Hallo VBAler,
eine frage und zwar suche ich mit dieser Art code in einem Ordner und allen seinen unteroirdnern nach dateien mit der Endung ".dat"
Da es aber sehr sehr viele Unterordner usw. gibt in denen zu suchen ist dauert die suche je nach anzahl der vorhandenen files sehr lange.
Gibt es vieleicht eine schnellere möglichkeit diese Dateien zu finden.

Falls nicht Danke trotzdem ! grüße Christain

:code
Dim objFileSearch As FileSearch
Dim strVerzeichnis As String, strDatei As String
strVerzeichnis = strDir
If strVerzeichnis = "" Then Exit Sub
' Name nach dem Gesucht wird !
strDatei = "*.DAT"
If strDatei = "" Then Exit Sub

Set objFileSearch = Application.FileSearch
x = 1
With objFileSearch
.LookIn = strVerzeichnis
.SearchSubFolders = True
.Filename = strDatei
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) = zeichengehtnicht Then
i = .FoundFiles.Count

  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: Nepumuk
Geschrieben am: 02.09.2004 19:50:48

Hallo chris,
schnell genug?


Option Explicit

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As LongAs Long

Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Private lngDirCount As Long
Private lngFileCount As Long
Private strFiles() As String

Public Sub start()
    Application.ScreenUpdating = False
    lngDirCount = 1
    lngFileCount = 0
    FindFiles "D:\Eigene Dateien\", "*.dat"
    Range(Cells(1, 1), Cells(lngFileCount, 1)) = WorksheetFunction.Transpose(strFiles)
    Application.ScreenUpdating = True
End Sub

Private Sub FindFiles(ByVal strFolderPath As StringByVal strSearch As String)
    Dim WFD As WIN32_FIND_DATA
    Dim lngSearch As Long
    Dim strDirName As String
    If Right$(strFolderPath, 1) <> "\" Then strFolderPath = strFolderPath & "\"
    lngSearch = FindFirstFile(strFolderPath & "*.*", WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
        GetFilesInFolder strFolderPath, strSearch
        Do
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
                strDirName = TrimNulls(WFD.cFileName)
                If (strDirName <> ".") And (strDirName <> "..") Then
                    lngDirCount = lngDirCount + 1
                    FindFiles strFolderPath & strDirName, strSearch
                End If
            End If
        Loop While FindNextFile(lngSearch, WFD)
        FindClose lngSearch
    End If
End Sub

Private Sub GetFilesInFolder(ByVal strFolderPath As StringByVal strSearch As String)
    Dim WFD As WIN32_FIND_DATA
    Dim lngSearch As Long
    Dim strFileName As String
    If Right$(strFolderPath, 1) <> "\" Then strFolderPath = strFolderPath & "\"
    lngSearch = FindFirstFile(strFolderPath & strSearch, WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
        Do
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY Then
                strFileName = TrimNulls(WFD.cFileName)
                lngFileCount = lngFileCount + 1
                ReDim Preserve strFiles(1 To lngFileCount)
                strFiles(lngFileCount) = strFolderPath & strFileName
            End If
        Loop While FindNextFile(lngSearch, WFD)
        FindClose lngSearch
    End If
End Sub

Private Function TrimNulls(ByVal strStringIn As StringAs String
    If InStr(strStringIn, Chr(0)) > 0 Then strStringIn = Left$(strStringIn, InStr(strStringIn, Chr(0)) - 1)
    TrimNulls = strStringIn
End Function


Gruß
Nepumuk


  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: chris b
Geschrieben am: 02.09.2004 19:54:04

Boa vielen Danke Nepumuk ,
jetzt muss ich mal schauen ob ich damit was anfangen kann , aber mit VBA gut sollte das klappen ... wenn nicht danke trotzdem !!!


  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: chris b
Geschrieben am: 02.09.2004 20:01:43

Hi Nepumuk,
habe es gerade mal in mein Excel eingebaut, funktioniert wunderbar !!
Ob es aber für das was ich es brauche auch sosuper funzt weiß ich erst morgen..
Darf ich mich evtl. per E-mail an dich wenden falls es dazu noch fragen geben sollte... weil dieses Posting wirst du sicher nicht mehr lesen wenn es ganz unten steht.. Danke schon erst einmal !!
Kurze erklärung versuche ich jetzt einaml rüberzubringen..
Mein Programm sucht wie gesagt alle files dann habe ich sie in einem Array un dieses lese ich dann eintrag für eintrag aus und dann öffnen ich nacheinander alle files also alle Pfade zu den dateien und lese mit einem weiterm Script dann bestimmte werte aus den Textfiles aus.
Aber ich versuche es morgen erst einmal selbst hinzubekommen.
Danke vielmals!!!!!!


  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: chris b
Geschrieben am: 02.09.2004 20:09:11

Hallo Nepumuk ch noch einmal,
habe es glaube ich selbst geschafft lese mit

For x = 1 To 5
cb = strFiles(x)
Next

Jetzt jeden einzelnen Pfad aus dann öffne ich mit

Open "Path" & FileName For Input As #1
..code



jetzt einzelne Datei und lese dort den wert aus und trage diesen dann in mein Excel ein .
Danke hast mir gut geholfen !!!!


  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: Nepumuk
Geschrieben am: 02.09.2004 20:21:22

Hallo chris,
freut mich das du es hinbekommst. Wenn du noch Fragen zu dem Code oder seine Anwendung hast, dann bleib in diesem Thread. Ich schaue fast jeden Tag die Beiträge nach, auf die ich geantwortet habe. Diese verschwinden meistens erst nach vier bis fünf Tagen im Archiv.
Gruß
Nepumuk


  


Betrifft: Vielen Dank Nepumuk !!!!!!! von: chris b
Geschrieben am: 03.09.2004 05:21:37




  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: chris b
Geschrieben am: 03.09.2004 07:01:47

Hallo Nepumuk,
habe alles super hinbekommen nur einmal möchte ich Dich noch in anspruch nehmen wenn du mir helfen kannst.
UNd zwar lasse ich in meinem Code dann alle dat Dateien die ich gefunden habe einlesen und
pnum und cycle in arrays schreiben und mir diese dann auch in Excel in Spalte 2 und 3 eintragen.
Wie ich das anstelle siehst du in dem Code den ich unten mit eingefügt habe.Vieleicht weißt du da auch noch eine "verschnellerung" weil auch für diese aktion mein VBA ziemlich lange braucht.
Vielen Dank schon einmal für deine riesenhilfe bis jetzt !!!

i = UBound(strFiles)

For x = 1 To i


Open strFiles(x) For Random As #1 Len = Len(DSatz1)
' Beispieldatei mit Get-Anweisung einlesen.
Position = 28 ' Datensatznummer definieren.
Get #1, 28, DSatz1 ' 3. Datensatz lesen.
Get #1, 31, DSatz2 ' 3. Datensatz lesen.
Close #1 ' Datei schließen


pnr = DSatz1.Name

pnr_wo = InStr(pnr, Chr(34))
pnr = Mid(pnr, pnr_wo + 1, 12)
pnr_wo = InStr(pnr, Chr(34))
pnr = Mid(pnr, 1, pnr_wo)
pnr = WorksheetFunction.Substitute(pnr, Chr(34), "")


cycle = DSatz2.Name

cycle_wo = InStr(cycle, Chr(34))
cycle = Mid(cycle, cycle_wo + 1, 12)
cycle_wo = InStr(cycle, Chr(34))
cycle = Mid(cycle, 1, cycle_wo)
cycle = WorksheetFunction.Substitute(cycle, Chr(34), "")


cyclet(x) = cycle
pnum(x) = pnr

Next

Range(Cells(1, 2), Cells(lngFileCount, 2)) = WorksheetFunction.Transpose(cyclet)
Range(Cells(1, 3), Cells(lngFileCount, 3)) = WorksheetFunction.Transpose(pnum)


  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: Nepumuk
Geschrieben am: 03.09.2004 18:55:54

Hallo chris,
da sehe ich mehrere Möglichkeit den Code schneller zu machen. Mir fällt, und das nicht nur bei dir, immer wieder auf, dass Variablen belegt werden, die dann nur einmal verwendet werden.
Beispiel:

i = UBound(strFiles)
For x = 1 To i

warum nicht

For x = 1 To UBound(strFiles)

oder

pnr = DSatz1.Name
pnr_wo = InStr(pnr, Chr(34))

warum nicht

pnr_wo = InStr(DSatz1.Name, Chr(34))

An Stelle von WorksheetFunction.Substitute würde ich Replace verwenden, das ist fast doppelt so schnell.

Wenn ich wüsste, was in den beiden ausgelesenen Strings steht, könnte ich die ganze Aktion, für die du sieben Zeilen benötigst

1. cycle = DSatz2.Name
2. cycle_wo = InStr(cycle, Chr(34))
3. cycle = Mid(cycle, cycle_wo + 1, 12)
4. cycle_wo = InStr(cycle, Chr(34))
5. cycle = Mid(cycle, 1, cycle_wo)
6. cycle = WorksheetFunction.Substitute(cycle, Chr(34), "")
7. cyclet(x) = cycle

warscheinlich in eine einzige zusammenfassen. Die ist zwar dann nur noch schwer zu durschauen, aber mit Sicherheit schneller.

Ich würde dir auch empfehlen, sprechende Variable zu verwenden. Ich habe Programme geschrieben, die etwas mehr als 5.000 Zeilen hatten. Wenn da nach ein paar Monaten eine Änderung nötig wird, kannst du mir Variablen wie "i" oder "x" in der Mitte des Makros nichts mehr anfangen und du musst dich durch den kompletten Code lesen, um zu wissen, worum es in dieser oder jener Zeile ging. Eine einmal definierte Variable muss auch nicht immer komplett ausgeschrieben werden. Meistens reichen die ersten drei Buchstaben und dann Strg + Leertaste drücken. Das funktioniert auch mit den meisten VBA - Befehlen und erleichtert die Arbeit doch sehr.
Gruß
Nepumuk


  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: chris b
Geschrieben am: 03.09.2004 20:11:56

Hallo Nepumuk,
erst einmal vielen vielen Dank wieder für deine Super tolle Antwort.
Wie gesagt ich nenn zwar meine kenntnisse immer "gut" weil ich meine etwas kann ich schon.
Aber natürlich bin ich kein Profi habe mir alles selbst beigebracht.

Zu deinen Tipps:da wusste ich nicht das es besser ist ich werde versuchen mir das anzugewöhnen so zu schreiben.
i = UBound(strFiles)
For x = 1 To i

warum nicht

For x = 1 To UBound(strFiles)

oder

pnr = DSatz1.Name
pnr_wo = InStr(pnr, Chr(34))

warum nicht

pnr_wo = InStr(DSatz1.Name, Chr(34))

'--------------------------------------------------------
An Stelle von WorksheetFunction.Substitute würde ich Replace verwenden, das ist fast doppelt so schnell.
Kenne den befehl nicht so gut besser habe glaube ich noch nicht damit gearbeitet.
Versuche natürlich auch das ganze etwas umzubauen.


Wenn ich wüsste, was in den beiden ausgelesenen Strings steht, könnte ich die ganze Aktion, für die du sieben Zeilen benötigst

1. cycle = DSatz2.Name
2. cycle_wo = InStr(cycle, Chr(34))
3. cycle = Mid(cycle, cycle_wo + 1, 12)
4. cycle_wo = InStr(cycle, Chr(34))
5. cycle = Mid(cycle, 1, cycle_wo)
6. cycle = WorksheetFunction.Substitute(cycle, Chr(34), "")
7. cyclet(x) = cycle


Also das ist so ich weiß leider nicht wie ich den code abkürzen kann.
1. cycle = DSatz2.Name
2. cycle_wo = InStr(cycle, Chr(34))
3. cycle = Mid(cycle, cycle_wo + 1, 12)
4. cycle_wo = InStr(cycle, Chr(34))
5. cycle = Mid(cycle, 1, cycle_wo)
6. cycle = WorksheetFunction.Substitute(cycle, Chr(34), "")
7. cyclet(x) = cycle

Lese in die eine Variable:cycle = DSatz2.Name
eine zeile aus einer textdatei aus.Und in dieser zeile steht mehr drinnen, sorry habe leider kein beispiel zur Hand im moment.Aber die zeile ist etwas länger und was ich aus diesen beiden Zeilen mit dem Code auslese ist das wort oder die Zahl die zwischen "" steht. z.b bei "4,356" ist es 4,356
Deshalb diese umstände:
Aber dein Tipp mit den zu vielen Variablen werde ich versuchen anzuwenden soweit es mir nach meinen erfahrungen und kenntnissen möglich ist.

Vielen Dank noch einmal und vieleicht kannst du mir ja den code zum auslesen zischen "" etwas verbessern. Vielen vielen Dank und ein schönes Wochenende wünsche ich Dir !!!!!


  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: Nepumuk
Geschrieben am: 03.09.2004 21:34:16

Hallo chris,
geht ganz einfach:


Public Sub test()
    Dim str_text As String
    str_text = "jaskejnvasjvnasjkn.jv.akj" & Chr(34) & "4,356" & Chr(34) & "jakdsfhakjskajbhhabvsjh"
    MsgBox Mid$(str_text, InStr(1, str_text, Chr(34)) + 1, Len(str_text) - InStr(1, str_text, Chr(34)) - InStr(1, StrReverse(str_text), Chr(34)))
End Sub


Gruß
Nepumuk


  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: chris b
Geschrieben am: 04.09.2004 02:04:24

Hallo Nepumuk,
leider verstehe ich deinen code nicht banz mit dem
jaskejnvasjvnasjkn.jv.akj" & Chr(34) & "4,356"

weil die Zahl 4,356 war nur ein beispiel es stehen in jeder datei verschiedene Werte.
Aber ich schau ´mir das ganze morgen noch einmal an ! Dankeschön !!!!
Gute n8 Chris


  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: chris b
Geschrieben am: 04.09.2004 08:44:57

Guten morgen Nepumuk,
konnte deinen code noch nicht testen, bin noch nicht daheim :)
Aber eine frage aus welchem Raum kommst du ?
Und hättest du evtl. mal lust mir Nachhilfe zu geben ?
Also meine natürlich keinen kurs ode so nur mal ein paar informationen auszutauschen und evtl. ein paar gute tipps für meine Programmierung.


  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: chris b
Geschrieben am: 04.09.2004 13:12:37

Hallo Nepumuk,
code zum auslesen des textes zwischen "" funktioniert pefekt.
Vielên Dank !!!!!!!!!!!!!

P.s habe mir den code lange betrachtet und bin fasziniert.
Kenne zwar alle befehle aber das so hinzuzauber ist einfach spitze !!! Danke


  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: Nepumuk
Geschrieben am: 04.09.2004 16:41:14

Hallo chris,
ich sitze hier in Nürnberg, stamme aber aus Wasserburg am Inn. Bin also waschechter Oberbayer (die kennst du sich sicher, das sind die mit Lederhosen und Laptop). Wenn du VBA besser beherrschen willst, dann schau dir hier im Forum (das Archiv nicht vergessen) die Beiträge an. Du wirst sicher schnell merken, das die verschiedenen Antworter unterschiedliche Levels haben. Such dir die besten raus, sonst hast du die nächsten zwanzig Jahre zu lesen. Vergleiche die Codes, die prinzipiell das selbe bewirken und lege dir ein Archiv mit Beispielen an.
Richtiges lernen fängt damit an, dass du dich mit Fragen beschäftigst auf die du nicht sofort eine Antwort parat hast und die du dir mit Unterstützung der VBA - Hilfe und eigenem Nachdenken eine Lösung erarbeitest. Das Forum bietet dir einen schier unerschöpflichen Fundus an verzwickten Fragen.
Gruß
Nepumuk


  


Betrifft: AW: Schnelle Dateisuche in Unterordnern incl. von: chris b
Geschrieben am: 04.09.2004 16:45:02

Danke Nepumuk !!!


 

Beiträge aus den Excel-Beispielen zum Thema "Schnelle Dateisuche in Unterordnern incl."