Anzeige
Archiv - Navigation
768to772
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
768to772
768to772
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

File Search geht nicht mehr

File Search geht nicht mehr
04.06.2006 13:45:51
Thomas
Hi Leute
Ich hab mir in Excel ein paar Makros geschrieben, die mir das einlesen von Messdaten erleichtern sollen.
Die Datei kann unter :
https://www.herber.de/bbs/user/34097.xls
runtergeladen werden.
Mit dem Button "Daten Erkennung aktivieren" öffnet sich ein "User Form" über das man den Quellordner (mit den Messdaten) aussuchen kann.
Das Makro "Read files" durchsucht den Quellordner nach Dateimustern. Bestimmte Dateien wie z.b. Agilent erkennt er und schreibt den Namen in die Datei unter die Zelle "Erkannte Messdaten". Andernfalls unter "Unbekannte Daten".
Vor jeder Zelle wird dann eine Checkbox erzeugt.
Im nächsten Schritt soll dann die erkannten Messdaten eingelesen werden (Sofern die Checkbox angeklickt ist). Dies hab ich hier aber weggelassen.
Bis vor kurzem hat auch alles wunderbar funktioniert. Nur leider jetzt nicht mehr. Ich hab keine ahnung wieso.
Den Ordner kann ich aussuchen und der Pfad wird in Zelle(6,8) geschrieben.
über:
With Application.FileSearch
.Filename = "*"
.LookIn = Cells(6, 8)
.SearchSubFolders = False 'keine Suche in Unterverzeichnissen
.Execute
If .FoundFiles.Count = 0 Then
Beep
MsgBox "Datei(en) wurde nicht gefunden!"
' Else
' MsgBox " Es befinden sich " & .FoundFiles.Count & "Dateien im Ordner"
End If
Count = .FoundFiles.Count
For i = 1 To .FoundFiles.Count
b = .FoundFiles(i)
arr(i) = Replace(b, Cells(6, 8) & "\", "")
' Cells(5 + i, 2) = arr(i)
Next
End With
Sollen alle Dateien im Ordner erfasst werden. Aber er bringt immer:
"Datei(en) wurde nicht gefunden!"
Bin echt am verzweifeln.
Für Hilfe wär ich echt dankbar
gruß
Thomas

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: File Search geht nicht mehr
04.06.2006 16:54:28
Matthias
Hallo Thomas,
schreibe mal
Msgbox Cells(6, 8)
vor (oder nach) .LookIn = Cells(6, 8)
Vielleicht ist gearde ein anderes Blatt aktiv.
Dan präzisieren mit
.LookIn = Sheets("Tabelle1").Cells(6, 8)
Gruß Matthias
AW: File Search geht nicht mehr
04.06.2006 19:28:28
Thomas
Ja hab ich schon probiert. Daran liegt es aber nicht.
Irgendwas mit Application.FileSearch geht schief.
Komischerweise hats schon mal funktioniert. Nur jetzt nicht mehr.
Bin echt am verzweifeln :-(
Hast dir die datei mal runtergeladen und ausprobiert ?
gruß
Thomas
AW: File Search geht nicht mehr
04.06.2006 19:34:36
Josef
Hallo Thomas!
Unter XL2003 macht Filesearch manchmal Probleme. Der Grund ist nicht ganz klar!
Check mal die Verweise die im VBE gesetzt sind. Steht dort der Verweis auf
"Microsoft Office X.X Object Library"?
Wenn's daran nicht liegt, kannst du ja vielleicht auf diesen Code ausweichen.
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit
'Dateien suchen und auflisten
'by Nepumuk

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 Long) As 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

Private Sub FindFiles(ByVal strFolderPath As String, ByVal 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 String, ByVal 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 String) As String
If InStr(strStringIn, Chr(0)) > 0 Then strStringIn = Left$(strStringIn, InStr(strStringIn, Chr(0)) - 1)
TrimNulls = strStringIn
End Function


Public Sub start()
lngDirCount = 1
lngFileCount = 0
FindFiles "C:\", "*.xls"
Range(Cells(1, 1), Cells(lngFileCount, 1)) = WorksheetFunction.Transpose(strFiles)
End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: File Search geht nicht mehr
04.06.2006 20:21:40
Thomas
Ok cool bin auf deinen Code umgestiegen. Funktioniert einwandfrei !!!!
Tausend dank man. Hast mir den Tag gerettet.
Eine Frage hab ich aber noch:
Ich möchte nicht, dass Unterordner durchsucht werden. Weisst du wie und wo ich das abstellen kann ?
Danke
gruß
Thomas
AW: File Search geht nicht mehr
04.06.2006 20:31:10
Josef
Hallo Thomas!
Schnell noch einen zusätzlichen Parameter und schon kann man das einstellen!
' **********************************************************************
' Modul: Modul4 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit
'Dateien suchen und auflisten
'by Nepumuk

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 Long) As 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

Private Sub FindFiles(ByVal strFolderPath As String, ByVal strSearch As String, Optional ByRef searchSubFolders As Boolean = False)
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 searchSubFolders Then
      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
    End If
  Loop While FindNextFile(lngSearch, WFD)
  FindClose lngSearch
End If
End Sub


Private Sub GetFilesInFolder(ByVal strFolderPath As String, ByVal 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 String) As String
If InStr(strStringIn, Chr(0)) > 0 Then strStringIn = Left$(strStringIn, InStr(strStringIn, Chr(0)) - 1)
TrimNulls = strStringIn
End Function


Public Sub start()
lngDirCount = 1
lngFileCount = 0
FindFiles "F:\Temp", "*.xls" ', True
Range(Cells(1, 1), Cells(lngFileCount, 1)) = WorksheetFunction.Transpose(strFiles)
End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
kleine Korrektur!
04.06.2006 20:43:09
Josef
Hallo nochmal!
Ein kleiner Fehler war noch drin!
Private Sub FindFiles(ByVal strFolderPath As String, ByVal strSearch As String, Optional ByRef SearchSubFolders As Boolean = False)
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 SearchSubFolders Then
      If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
        strDirName = TrimNulls(WFD.cFileName)
        If (strDirName <> ".") And (strDirName <> "..") Then
          lngDirCount = lngDirCount + 1
          FindFiles strFolderPath & strDirName, strSearch, SearchSubFolders
        End If
      End If
    End If
  Loop While FindNextFile(lngSearch, WFD)
  FindClose lngSearch
End If
End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: File Search geht nicht mehr
04.06.2006 22:22:23
Thomas
Funzt einwandfrei !!!!!!
Danke Danke
gruß
thomas

312 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige