Ordner überwachen auf neue Dateien
10.05.2017 16:44:50
Frank
ich möchte über VBA einen Ordner daraufhin überwachen, ob eine xls Datei hinein kopiert wurde (diese wird von einem Meßinstrument erzeugt). Sobald eine neue Datei darin auftaucht, soll eine Aktion erfolgen.
In diesem Fall sollen bestimmte Inhalte aus der neuen Datei in eine andere Datei kopiert werden. Diesen Part kann ich alleine lösen.
Was mir fehlt ist die Überwachung des Ordners auf eine neue Datei.
Dies soll ja über die OnTime Funktion gehen.
Dazu habe ich auch einen Code im Archiv gefunden, welcher bei Auftauchen neuer Dateien im zu überwachenden Ordner diese in einen anderen Ordner verschiebt.
Problem bei dem Code ist, daß nach Start der Sub Start_Prozedur() nur beim ersten Mal eine neue Datei verschoben wird, alle danach in den Ordner kopierten Dateien werden nicht mehr verschoben.
Hier der Beitrag mit Code
Tino schrieb am 11.02.2010 17:03:42
Hallo,
versuch mal dies.
Ziel, Quelle und Dateiextension noch anpassen.
Über OnTime wird der Code jede Minute ausgeführt.
kommt als Code in DieseArbeitsmappe
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopTimer
End Sub
Option Explicit
Public dTimer As Date
Sub Start_Prozedur()
Call StartTimer
End Sub
Sub Stop_Prozedur()
Call StopTimer
End Sub
Sub StartTimer()
dTimer = Now + TimeSerial(0, 0, 10) 'Timer auf eine Minute
Application.OnTime dTimer, "Check_Ordner"
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime dTimer, "Check_Ordner", Schedule:=False
End Sub
Sub Check_Ordner()
Dim strFile As String
'welche Ordner überwachen
Const strQuelle As String = "C:\L-PC\Musik\"
'welche Dateien suchen
Const DateiTyp As String = "*.xls"
'Ziel, wo sollen die Dateien hin
Const strZiel As String = "C:\L-PC\Test\"
strFile = Dir(strQuelle & DateiTyp)
On Error Resume Next 'sollte Datei geöffnet sein
Do While strFile ""
Name strQuelle & strFile As strZiel & strFile
strFile = Dir()
Loop
Call StartTimer
End Sub