Dateien/Zeilen auslesen
30.05.2015 18:42:48
Schokohexe
Hallo
Bin in Sachen VBA Anfänger und benötige Hilfe in der Umstellung eines VBA-Codes.
Ich habe eine Datei geerbt, die Zeilen von Checklisten (excel-dateien)ausliest und in eine Liste zusammenfasst.
Bisher hat dies auch wunderbar funktioniert, jedoch mit der Umstellung auf Excel 2007 geht das Makro nicht mehr (application.filesearch). Habe zwar einiges über die Thematik gefunden, jedoch habe ich es nicht zum Laufen gebracht.
Vielleicht könnt Ihr mir helfen.
Danke und Gruß Leon
VBA-Code:
Sub auslesen()
Dim wbMappe As Excel.Workbook
Dim strMappe As String
Dim strPfad As String
Dim loDateien As Long
Dim loZeile As Long
Dim boTabelle As Boolean
Dim inTabellen As Integer
loZeile = 6
strPfad = Ordner_Auswahl
With Application.FileSearch
.NewSearch
.LookIn = strPfad
.SearchSubFolders = False
.Filename = "*.*"
If .Execute() > 0 Then
For loDateien = 1 To .FoundFiles.Count
strMappe = Mid(.FoundFiles(loDateien), Len(strPfad) + 2)
Set wbMappe = GetObject(strPfad & "\" & strMappe)
With wbMappe
For inTabellen = 1 To .Worksheets.Count
If .Worksheets(inTabellen).Name = "Summery" Then
boTabelle = True
Exit For
End If
Next inTabellen
If boTabelle = True Then
ThisWorkbook.Worksheets("Checklisten").Cells(loZeile, 1) = strMappe
.Worksheets(inTabellen).Range("B5:LA5").Copy
ThisWorkbook.Worksheets("Checklisten").Cells(loZeile, 2).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
boTabelle = False
End If
.Close
End With
loZeile = loZeile + 1
Next loDateien
End If
End With
End Sub
Function Ordner_Auswahl()
Const WINDOW_HANDLE = 0
Const FOLDERS_ONLY As Long = 1
Const DEFPATH As Variant = "" ' z.B. Vorgabepfad "D:\" angeben
Dim Wscript As Application
Dim objShell As Object
Dim objFolder As Object
Dim objFolderItem As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Wählen Sie einen Ordner aus: ", _
FOLDERS_ONLY, DEFPATH)
'Set objFolder = objShell.BrowseForFolder(0&, "Ordner wählen oder anlegen...", FOLDERS_ONLY, _
DEFPATH)
If objFolder Is Nothing Then Exit Function
Set objFolderItem = objFolder.Self
Ordner_Auswahl = objFolderItem.Path
End Function