Import aus anderen xls Dateien
15.02.2015 13:27:07
Ulf
ich würde mich freuen, wenn ihr mir bei meinem Problem helfen könntet.
Grundsätzliche Beschreibung:
Die Datei Auswertung.xlsm soll regelmäßig (10-minütlich) Daten aus anderen Quellen abrufen, mit den Daten ein paar Berechnungen durchführen und die Ergebnisse in einem Diagramm und einer kleinen Liste darstellen. Bei den Nutzern soll die Datei rund um die Uhr laufen. Eine Interaktion der Nutzer ist nicht (bzw. nur minimal) vorgesehen, d.h. die Nutzer sollen nur die jeweils aktuellen Ergebnisse präsentiert bekommen. Der Datenabruf soll im Hintergrund laufen.
Eine erste lauffähige Version habe ich schon hinbekommen, allerdings kann diese nicht alle gewünschten Funktionen erbringen und der Datenabruf ist auch noch nicht optimal.
Detaillierte Beschreibung:
Die Quelldateien liegen in dem Netzwerkordner X:\Daten
Die Benennung der Dateien folgt einem festen Schema: Datum (yyyymmdd) & Betriebsdaten_V & laufende Versionsnummer
Pro Tag werden zwischen 1 bis 30 Versionen eingestellt
Es kann sein, dass einzelne Versionsnummern ausgelassen werden
Der Aufbau der Dateien ist identisch
Importiert werden soll von der jeweils aktuellen Version der Bereich C1:C113 vom Blatt Tabelle1 (Abfrage alle 10 Minuten)
Es ist nicht auszuschließen, dass die Quelldatei zum Zeitpunkt des Abrufs von einem anderen Nutzer geöffnet ist (aber nicht verändert wird)
Meine Wünsche:
1. Aktuell ist der Import sehr langsam. Es wird im vorgegebenen Zeittakt immer importiert. Sinnvoll wäre es aber, wenn in einem ersten Schritt erst mal nur geprüft wird, ob seit der letzten Abfrage eine neue Version eingestellt wurde. Falls ja dann importieren, falls nein dann nix machen. Zielbereich Tabelle1 ab Zelle E1
2. Zusätzlich beim Starten von Auswertung.xlsm sowie einmalig täglich nach Mitternacht von der letzten Version des Vortags den Bereich C1:C113 auslesen und in Tabelle 1 ab Zelle D1 importieren
3. Zusätzlich ab 20 Uhr ebenfalls alle 10 Minuten von der neuesten Version des Folgetages den Bereich C1:C113 in Tabelle1 ab Zelle F1 importieren (vorherige Abfrage o/b neue Version vorhanden wie unter 1. beschrieben)
Bonus 1: Wenn für den laufenden Tag eine neue Version gefunden wurde MsgBox Neue Version! die durch den Nutzer mit ok zu bestätigen ist. Import erfolgt aber unabhängig von der Bestätigung.
Bonus 2: Uhrzeit der letzten Abfrage in Tabelle1 Zelle A1 eintragen.
Sonstiges:
Bei den abgerufenen Daten steht in Zeile 5 die jeweilige Version der Datei. Das kann vielleicht genutzt werde, um zu vergleichen ob es eine neue Version gibt.
Hier noch zur Info den bisher von mir verwendeten Code (ohne VBA-Kenntnisse aus verschiedenen Quellen zusammengesucht und für meine Zwecke angepasst):
'** Dimensionierung der Variablen
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object, StrDate As String, strFile As String
Sub Bereich_auslesen1()
Application.OnTime Now + TimeValue("00:10:00"), "Bereich_auslesen1"
'**aktuelles Datum
StrDate = Format(Now(), "yyyymmdd")
'** Angaben zur auszulesenden Zelle
pfad = "X:\Daten"
blatt = "Tabelle1"
Set bereich = Range("C1:C113")
'Version prüfen und Datenabruf starten
For vers = 30 To 1 Step -1
datei = StrDate & "Betriebsdaten_V" & vers & ".xls"
If Dir(pfad & "\" & datei) "" Then
Call Bereich_auslesen2
Exit For
End If
Next vers
End Sub Sub Bereich_auslesen2()
'** Bereich auslesen
For Each zelle In bereich
'** Zellen umwandeln
zelle = zelle.Address(False, False)
'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
Next zelle
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