Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zelle aus vielen geschlossenen Dateien auslesen

Zelle aus vielen geschlossenen Dateien auslesen
12.10.2017 14:53:24
Lukas
Hallo Zusammen,
ich bin auf der Suche nach einer Lösung und habe nun vermutlich schon das ganze Internet abgesucht.
Ich habe eine Problem bei einer statistischen Auswertung. Ich möchte von ca 500 geschlossenen .xlsm Dateien, welche auf einem Netzwerklaufwerk liegen, je 5 bestimmte Zellen auslesen. Im ersten schritt habe ich versucht dies über ececuteexcel4macro zu lösen. Hierzu lese ich zuerst den Pfad des Ordners aus in dem die Dateien liegen und lasse dann eine Schleife über alle Dateien laufen. Das Problem ist jedoch, immer wenn meine getValue Function durch gelaufen ist, kommt ein Fenster welches die Werte aktualsieren möchte, ergo ich müsste die entsprechende Datei noch einmal manuel anklicken. Wenn ich dies mache bekomme ich auch die richtigen werte. Jedoch ist dies bei 500 Dateien uns je 5 Zellen sehr viel Klickerrei. Hätte jemand eine Idee, wie ich dieses Problem lösen könnte? Ich habe den selben Vorgang auch schon realisiert indem ich die Datei jedes mal öffne, so benötige ich jedoch ca 15 min um alle Daten zu bekommen.
Hier mein aktueller Code
Sub Datenholen()
Dim arrDaten(500, 5), file As Variant
Dim fsObj As Object, fsOrdner As Object, files As Object
Dim blatt As String, Nr As String, Datum As String, Programm As String, laufstrecke As String
Dim BI As String, strOrdner As String, test As String, Datei As String
Dim Zähler As Integer
Dim name As String
Dim namesheet As String
blatt = "Tabelle1"
Nr = "AM2"
Datum = "N2"
Programm = "AM11"
laufstrecke = "AM16"
BI = "AM8"
name = ActiveWorkbook.name
namesheet = ActiveSheet.name
'Ordner auswählen
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "P:\B\BGP"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strOrdner = .SelectedItems(1)
If Right(strOrdner, 1)  "\" Then strOrdner = strOrdner & "\"
Else
strOrdner = ""
End If
End With
If strOrdner = "" Then MsgBox ("Kein Ordner gewählt!") 'Else MsgBox strOrdner
'strOrdner enthält Ordnerstring
Set fsObj = VBA.CreateObject("Scripting.FileSystemObject")
Set fsOrdner = fsObj.getfolder(strOrdner)
Set files = fsOrdner.files
Zähler = 1
For Each file In files
Datei = file
Datei = Dir(file)
Workbooks(name).Worksheets(namesheet).Cells(Zähler + 5, 1).Value = Zähler
Workbooks(name).Worksheets(namesheet).Cells(Zähler + 5, 1).Value = GetValue(strOrdner, Datei,  _
blatt, Nr)
Workbooks(name).Worksheets(namesheet).Cells(Zähler + 5, 1).Value = GetValue(strOrdner, Datei,  _
blatt, Datum)
Workbooks(name).Worksheets(namesheet).Cells(Zähler + 5, 1).Value = GetValue(strOrdner, Datei,  _
blatt, Programm)
Workbooks(name).Worksheets(namesheet).Cells(Zähler + 5, 1).Value = GetValue(strOrdner, Datei,  _
blatt, laufstrecke)
Workbooks(name).Worksheets(namesheet).Cells(Zähler + 5, 1).Value = GetValue(strOrdner, Datei,  _
blatt, BI)
Zähler = Zähler + 1
Next file
End Sub

Private Function GetValue(pfad, Datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen
'*** Dimensionierung der Variablen
Dim arg As String
'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) "\" Then pfad = pfad & "\"
If Dir(pfad & Datei) = "" Then
GetValue = "datei Not Found"
Exit Function
End If
'** Das Argument erstellen
arg = "'" & pfad & "[" & Datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , _
xlR1C1)
'** Auslesen über Excel4Macro
GetValue = ExecuteExcel4Macro(arg)
End Function

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

Betreff
Datum
Anwender
Anzeige
DisplayAlerts
12.10.2017 15:06:33
lupo1
Application.DisplayAlerts = False
Deine Retrieves
Application.DisplayAlerts = True
AW: DisplayAlerts
12.10.2017 16:13:22
Lukas
Hallo Lupo1,
und danke erst mal für die Fixe Antwort. Ich hatte die Displayalerts schon probiert, aber diese hatten mein Problem nicht gelöst. Aber durch erneutes versuchen habe ich die Fehlermeldung etwas besser gesehen und es war ein Error2023, welcher durch den Dateinamen entsteht. Leider sind in jedem dateinamen zwei ' für Zoll, also z.B. 20'', damit kommt das executeexel nicht klar denke ich.
daher werde ich jetzt mal schauen ob ich mir ein kleines Makro schreibe, welches mir auf die schnelle bei ein paar Hundert Dateien den Namen ändert. Vielen Dank jedoch nochmal!!!
Anzeige

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige