Dateiupload als Eventtrigger
18.08.2020 10:19:44
Alex
Ich habe von meinem Chef die Aufgabe bekommen mit VBA ein Programm zu schreiben das folgendes tun soll:
Eine Datei erzeugen, diese in OneDrive hochladen und zwar im Minutentakt von verschiedenen Standorten aus.
Hierbei sollen diverse Details im Dateinamen stehen, wie Datum, Uhrzeit der Dateierstellung, Standortnummer und eine laufende Nummer. (das habe ich soweit hinbekommen)
Nun habe ich von Microsoft einen Code Schnipsel gefunden, der durch ein Event getriggert werden soll und zwar sobald der Sync der Datei fertig ist. Der Code soll sobald der Sync abgeschlossen ist, genau diesen Zeitpunkt in die Excel Tabelle schreiben. Mein Code derzeit speichert die Datei nämlich in das lokale OneDrive Verzeichnis und synced danach (was auch so gewollt ist).
Hier liegt nun mein Problem, ich habe keine Ahnung wie ich Events einbaue. Habe da etwas von EventHandlern gelesen, aber ich finde die Thematik sehr schwierig zu verstehen und hoffe daher, dass ihr mir weiterhelfen könnt...
Zweck der Sache soll sein, dass ich durch die 2 verschiedenen Zeiten (Dateierstellung, Abschluss Sync) die Upload bzw. Sync Zeit messen kann, in der gleichen Zeile sollen eben Dateiname, laufende Nummer und Standortnummer stehen.
Mein Timer von 1 Minute funktioniert auch nicht, also falls euch da sofort was auffällt, teilt es mir gerne mit.
Ich habe zum einen ein "Schreibskript", welches die Datei erzeugt, mit allen Details im Namen und welches auch dafür zuständig ist, die Datei ins richtige Verzeichnis zu speichern und zum anderen ein "Leseskript", welches auf einem anderen Rechner laufen wird. Es soll schließlich die Exceltabelle füllen.
Hier mein Schreibskript:
Public Sub Workbook_Open()
Dim lv_createfile As Double
Dim lv_timer As Double
Dim filename As String
Dim lv_standort As Double
Dim lv_lfdnr_offset As Double
Dim lv_lfdnr As Double
Dim lv_zeile As Double
Dim lv_maxcount As Double
Dim datExitTime As Date
Dim lv_Start As Variant
Dim lv_Ende As Variant
Dim fso As Object
Dim strFileFrom As String
Dim strFileTo As String
lv_createfile = 1
lv_standort = 999000000 '99 = Nr-Range des Standorts
lv_lfdnr_offset = 0 '0000000 = lfd. Nr. am Tag oder insgesamt
lv_lfdnr = 0
lv_maxcount = 20
lv_Start = Now
lv_Ende = Now
On Error GoTo MyErrorHandler
datExitTime = Now + TimeSerial(0, 5, 0) 'Wie lange soll das Programm max. laufen? HH, MM, SS
lv_zeile = 1
Set fso = CreateObject("Scripting.FileSystemObject")
While lv_createfile
Public Sub StartTimeCounter()
Application.OnTime Now + TimeValue("00:01:00"), "Workbook_Open" 'stunden, minuten, sekunden
End Sub
Public Sub Worksheet_Sync(ByVal SyncEventType As Office.MsoSyncEventType)
iRow = Cells(Rows.Count, "F").End(xlUp).Row
If SyncEventType = msoSyncEventUploadSucceeded Or _
SyncEventType = msoSyncEventDownloadSucceeded Then
iRow = iRow + 1
Cells(iRow, 6).Value = Format(Now, "hh:mm:ss") 'Uhrzeit des fertiggestellten _
Uploads wird in Spalte 6 (F) eingetragen
Cells(iRow, 7).Value = Format(Now, "dd-mm-yyyy") 'Datum des Upload wird in Spalte 7 ( _
G) eingetragen
End If
End Sub
Und Hier mein Leseskript:
Sub Einlesen()
Dim zeile As Variant
Dim sFile As String, sPattern As String, sPath As String
Dim iRow As Integer
Dim fso As Object
Dim file As Object
'Columns(1).ClearContents
sPath = "C:\Zielverzeichnis\" ' Hier gibst Du Deinen Pfand zum gewünschten Verzeichnis an
If Right(sPath, 1) "\" Then sPath = sPath & "\"
sPattern = "*.*"
sFile = Dir(sPath & sPattern)
Sheets("Test").Activate
'Cells.Select
'Selection.ClearContents
'Range("A1").Select
'Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Select
Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
Set fso = CreateObject("Scripting.FileSystemObject")
iRow = Cells(Rows.Count, "A").End(xlUp).Row
Do Until sFile = ""
iRow = iRow + 1
Cells(iRow, 1).Value = sFile
Cells(iRow, 2).Value = Mid(sFile, 1, 3)
Cells(iRow, 3).Value = Mid(sFile, 4, 6)
Cells(iRow, 4).Value = Mid(sFile, 11, 6)
Cells(iRow, 5).Value = Mid(sFile, 18, 6)
Cells(iRow, 8).Value = "1-Übertragen"
'Set file = fso.GetFile(sPath & "\" & sFile)
'Cells(iRow, 7).Value = file.DateLastAccessed
Kill sPath & "\" & sFile
Cells(iRow, 9).Value = "2-Gelöscht"
sFile = Dir()
Loop
For zeile = 1 To Cells.SpecialCells(xlLastCell).Row
Next
End Sub 'Bei erneutem Aufruf werden die alten Funde überschrieben