Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1584to1588
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

Textdatei als Endlosschleife (6)

Textdatei als Endlosschleife (6)
11.10.2017 16:30:51
Rainer
Hallo Excelfreunde,
hier geht es weiter aus der Thematik "Textdatei als Endlosschleife":
https://www.herber.de/cgi-bin/callthread.pl?index=1571273
https://www.herber.de/cgi-bin/callthread.pl?index=1523976
https://www.herber.de/cgi-bin/callthread.pl?index=1525132
https://www.herber.de/cgi-bin/callthread.pl?index=1528578
https://www.herber.de/cgi-bin/callthread.pl?index=1529873
Ich habe versucht den Code etwas zu straffen und "nutzlose" Dateizugriffe zu verhindern. Nur klappt es nicht so recht. Folgender Code funktioniert wunderbar:

'Start the loop
While MeasONOFF = 2
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Update Querytables
For Each qt In Import.QueryTables
On Error Resume Next
qt.Refresh (BackgroundQuery)
Next
B7 = ThisWorkbook.Sheets("Import").Range("B7")
'Write the old Import time into B7
For i = 1 To 3
ThisWorkbook.Sheets("Import").Cells(7, 3 * i - 1) = FileDateTime(Datei(i - 1))
Next i
If ThisWorkbook.Sheets("Import").Range("B7")  B7 Then
'The Time of the Measurement File has changed
Einlesen
ThisWorkbook.Sheets("MAIN").Range("AF31") = n
n = 1
End If
n = n + 1
If MeasONOFF  2 Then
Call Beenden
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
DoEvents
End With
Wend 'Restart the loop (While MeasONOFF = 2)
Aber in JEDEM Durchlauf findet das "Update Querytables" statt, dass heißt ein Dateizugriff. Diese Dateien ändern sich jedoch in Intervallen von 2 Sekunden aufwärts, so dass es nicht in jedem Zyklus ein Update machen müsste.
Ich habe also versucht:

For i = 1 To 3
ThisWorkbook.Sheets("Import").Cells(7, 3 * i - 1) = FileDateTime(Datei(i - 1))
Next i

If ThisWorkbook.Sheets("Import").Range("B7")  B7 Then
'The Time of the Measurement File has changed
'Update Querytables
For Each qt In Import.QueryTables
On Error Resume Next
qt.Refresh (BackgroundQuery)
Next
End If
Damit sollte er nur noch das Änderungsdatum der Datei prüfen. Aber nun kommts, ohne einen "Zugriff" auf die Datei (sei es über QueryTable oder auch über Workbook.Open) liefert mir die Funktion FileDateTime(Datei(i - 1)) nur noch ca. alle 10 Sekunden einen aktuellen Wert.
Auch ein alternativer Versuch zu FileDateTime hat exakt das gleiche Resultat:

Dim fileModDate As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile()
fileModDate = f.DateLastModified

Hat jemand eine Idee für dieses "merkwürdige Benehmen"?
Danke und Gruß,
Rainer

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Textdatei als Endlosschleife (6)
12.10.2017 02:45:35
fcs
Hallo Reiner,
Hat jemand eine Idee für dieses "merkwürdige Benehmen"?
Ich nicht - möglicherweise treibt der ständige Zugriff auf das Dateisystem Windows in den Wahnsinn.
Ich würde das importieren der Daten im Sekunden-Takt oder 2-Sekunden_Takt per OnTime steuern.
Das Grundgerüstgerüst hab ich dir gebaut. Wobei ich natürlich nicht weiss, wie der Rest deines vorhandenen Makros integriert werden muss - wahrscheinlich in das Makro OnTime_Start.
Wahrscheinlich kannst du zusätzlich den Update der Querytables in den If-Teil nach dem Zeitververgleich verschieben vor das Einlesen.
Gruß
Franz
'Code in einem allgemeinen Modul
Public pStartzeit As Date, n As Integer, MeasONOFF, Datei()
Public Sub OnTime_Start()
'dieses Makro ggf. in Workbook_Open starten
If pStartzeit  0 Then
Call OnTime_Ende_Abbrechen
End If
'hier ggf. die auszuwertenden Dateien festlegen
Datei(0) = "xxyz"
Datei(1) = "ABCD"
Datei(2) = "zyx"
n = 1
MeasONOFF = 2
Call OnTime_Action
End Sub
Public Sub OnTime_Action()
'Hier die auszuführenden Actionen programmieren
'Dabei darauf achten, dass die involviertwn Arbeitsmappen und _
Tabellenblätter vollsändig referenziert werden!
Dim i As Integer, B7, qt As QueryTable
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
With ThisWorkbook.Worksheets("Import")
'Update Querytables
For Each qt In .QueryTables
On Error Resume Next
qt.Refresh BackgroundQuery:=False
Next
B7 = .Range("B7")
'Write the old Import time into B7
For i = 1 To 3
.Cells(7, 3 * i - 1) = FileDateTime(Datei(i - 1))
Next i
If .Range("B7")  B7 Then
'The Time of the Measurement File has changed
Einlesen
ThisWorkbook.Sheets("MAIN").Range("AF31") = n
n = 1
End If
End With
n = n + 1
If MeasONOFF  2 Then
Call OnTime_Ende_Abbrechen
Call Beenden
Else
'nächste pStartzeit für das Prüfen von Datum/Zeit der Dateien
pStartzeit = Now + TimeSerial(Hour:=0, Minute:=0, Second:=2)
Application.OnTime pStartzeit, "OnTime_Action"
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Public Sub OnTime_Ende_Abbrechen()
'Dieses Makro sollte von der Workbook_BeforeClose-Ereignisprozedur gestartet _
werden, damit der OnTime-Aufruf vor dem Schliessen der Datei aus der _
OnTime-Liste gelöscht wird
On Error Resume Next
Application.OnTime earliesttime:=pStartzeit, Procedure:="OnTime_Action", Schedule:=False
pStartzeit = 0
End Sub
'Unter "DieseArbeitsmappe"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call OnTime_Ende_Abbrechen
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige