Anzeige
Archiv - Navigation
1428to1432
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
Inhaltsverzeichnis

Dateien/Zeilen auslesen

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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateien/Zeilen auslesen
31.05.2015 11:09:12
fcs
Hallo Leon.
nachfolgend dein Makro entsprechend angepasst.
Den Suchstring für die Dir-Funktion muss du ggf. noch etwas anpassen.
Bei der Function Ordner_Auswahl kannst du mit deiner Variante weiter arbeiten oder meine nehmen, die eine VBA-interne Methode für den Auswahldialog verwendet.
Gruß
Franz
Sub auslesen()
Dim wbMappe As Excel.Workbook
Dim wksZiel As Excel.Worksheet
Dim strMappe As String
Dim strPfad As String
Dim loZeile As Long, StatusCalc As Long
Dim inTabellen As Integer
loZeile = 6
strPfad = Ordner_Auswahl()
If strPfad = "" Then Exit Sub
strMappe = Dir(strPfad & "\*.xlsx", vbNormal)
If strMappe = "" Then Exit Sub
Set wksZiel = ThisWorkbook.Worksheets("Checklisten")
'Makrobremsen lösen
With Application
.EnableEvents = False
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Do Until strMappe = ""
Set wbMappe = GetObject(strPfad & "\" & strMappe)
With wbMappe
For inTabellen = 1 To .Worksheets.Count
If .Worksheets(inTabellen).Name = "Summery" Then
wksZiel.Cells(loZeile, 1) = strMappe
.Worksheets(inTabellen).Range("B5:LA5").Copy
wksZiel.Cells(loZeile, 2).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
loZeile = loZeile + 1
Exit For
End If
Next inTabellen
.Close savechanges:=False
End With
strMappe = Dir
Loop
'Makrobremsen zurücksetzen
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub
Function Ordner_Auswahl(Optional ByVal strInitialFolder As String, _
Optional ByVal strTitle As String = "Bitte Ordner auswählen") As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = strTitle
If strInitialFolder <> "" Then .InitialFileName = strInitialFolder
If .Show = -1 Then
Ordner_Auswahl = .SelectedItems(1)
End If
End With
End Function

Anzeige
AW: Dateien/Zeilen auslesen
31.05.2015 20:16:10
Leon
Hallo Franz
Velen Dank funktioniert sehr gut. Dies hilft mir sehr
Gruß
Leon

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige