ich möchte aus einer Excel-Datei heraus alle Excel-Dateien eines bestimmten Verzeichnisses öffnen lassen und in jeder Datei nach einer bestimmten Info suchen lassen. Wie mache ich das?
Nicole
ich möchte aus einer Excel-Datei heraus alle Excel-Dateien eines bestimmten Verzeichnisses öffnen lassen und in jeder Datei nach einer bestimmten Info suchen lassen. Wie mache ich das?
Nicole
Bye
Nike
es soll angezeigt werden, in welcher Datei die Infos gefunden wurden. Es würde sich anbieten, das Ergebnis (also die Dateinamen) in die ausführende Excel-Datei auflisten zu lassen.
Option ExplicitCode eingefügt mit Syntaxhighlighter 1.14Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As InfoT) As Long
Private Declare Function CoTaskMemFree Lib "ole32" (ByVal hMem As Long) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpStr1 As String, ByVal lpStr2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pList As Long, ByVal lpBuffer As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassname As String, ByVal lpWindowName As String) As LongPrivate Type InfoT
hwnd As Long
Root As Long
DisplayName As Long
Title As Long
Flags As Long
FName As Long
lParam As Long
Image As Long
End TypePrivate Function GetAOrdner() As String
Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String
ChDir "F:\"
With xl
.hwnd = FindWindow("xlmain", vbNullString)
.Title = lstrcat("Bitte wählen Sie ein Verzeichnis", "")
.Flags = &H40
End With
IDList = SHBrowseForFolder(xl)
If IDList <> 0 Then
FolderName = Space(256)
RVal = SHGetPathFromIDList(IDList, FolderName)
CoTaskMemFree (IDList)
FolderName = Trim(FolderName)
FolderName = Left(FolderName, Len(FolderName) - 1)
End If
GetAOrdner = FolderName
End FunctionPublic Sub Nicole()
Dim zellen As Range, Suchbegriff As String, Ordner As String
Dim index1 As Integer, index2 As Integer, Tabelle As Worksheet
Set Tabelle = ActiveSheet
Suchbegriff = InputBox("Suchbegriff eingeben", "Eingabe")
With Application
.ScreenUpdating = False
.ShowWindowsInTaskbar = False
End With
If Suchbegriff <> "" Then
Ordner = GetAOrdner
If Ordner <> "" Then
Columns(1).ClearContents
Cells(1, 1) = Suchbegriff
With Application.FileSearch
.LookIn = Ordner
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For index1 = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(index1)
For index2 = 1 To Worksheets.Count
With Sheets(index2).Cells
Set zellen = .Find(What:=Trim(Suchbegriff), LookAt:=xlWhole, MatchCase:=False)
If Not zellen Is Nothing Then
Tabelle.Cells(Tabelle.Range("A65536").End(xlUp).Row + 1, 1) = ActiveWorkbook.Name
Exit For
End If
End With
Next
ActiveWorkbook.Close False
Next
End If
End With
End If
End If
With Application
.ScreenUpdating = True
.ShowWindowsInTaskbar = True
End With
End Sub
Option ExplicitCode eingefügt mit Syntaxhighlighter 1.14Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As InfoT) As Long
Private Declare Function CoTaskMemFree Lib "ole32" (ByVal hMem As Long) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpStr1 As String, ByVal lpStr2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pList As Long, ByVal lpBuffer As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassname As String, ByVal lpWindowName As String) As LongPrivate Type InfoT
hwnd As Long
Root As Long
DisplayName As Long
Title As Long
Flags As Long
FName As Long
lParam As Long
Image As Long
End TypePrivate Function GetAOrdner() As String
Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String
With xl
.hwnd = FindWindow("xlmain", vbNullString)
.Title = lstrcat("Bitte wählen Sie ein Verzeichnis", "")
.Flags = 1
End With
IDList = SHBrowseForFolder(xl)
If IDList <> 0 Then
FolderName = Space(256)
RVal = SHGetPathFromIDList(IDList, FolderName)
CoTaskMemFree (IDList)
FolderName = Trim(FolderName)
FolderName = Left(FolderName, Len(FolderName) - 1)
End If
GetAOrdner = FolderName
End FunctionPublic Sub Nicole()
Dim zellen As Range, Suchbegriff As String, Ordner As String
Dim index1 As Integer, index2 As Integer, Tabelle As Worksheet
Set Tabelle = ActiveSheet
Suchbegriff = InputBox("Suchbegriff eingeben", "Eingabe")
With Application
.ScreenUpdating = False
.ShowWindowsInTaskbar = False
End With
If Suchbegriff <> "" Then
Ordner = GetAOrdner
If Ordner <> "" Then
Columns(1).ClearContents
Cells(1, 1) = Suchbegriff
With Application.FileSearch
.LookIn = Ordner
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For index1 = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(index1)
For index2 = 1 To Worksheets.Count
With Sheets(index2).Cells
Set zellen = .Find(What:=Trim(Suchbegriff), LookAt:=xlWhole, MatchCase:=False)
If Not zellen Is Nothing Then
Tabelle.Cells(Tabelle.Range("A65536").End(xlUp).Row + 1, 1) = ActiveWorkbook.Name
Sheets(index2).Select
Range(zellen.Address).Select
Exit For
End If
End With
Next
If zellen Is Nothing Then ActiveWorkbook.Close False
Next
End If
End With
End If
End If
With Application
.ScreenUpdating = True
.ShowWindowsInTaskbar = True
End With
End Sub