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