Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1776to1780
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

Dateiupload als Eventtrigger

Dateiupload als Eventtrigger
18.08.2020 10:19:44
Alex
Hallo liebe Excel Profis, ich benötige unbedingt Hilfe.
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

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateiupload als Eventtrigger
18.08.2020 15:55:40
Mullit
Hallo,
damit hab ich auch noch nicht viel gemacht, aber erstmal nur soviel, erstens ist die alte Hilfe falsch: das _Sync-Event ist ein Workbook-Event würde also ein Workbook-Objekt erfordern (Workbook_Sync), aber viel gravierender es wird von M$ als veraltet eingestuft und sollte nicht mehr genutzt werden:
https://docs.microsoft.com/en-us/office/vba/api/excel.workbook.sync(event)
Gruß, Mullit
AW: Dateiupload als Eventtrigger
18.08.2020 16:04:19
Alex
Hallo Mullit,
erstmal vielen Dank für die schnelle Antwort. Leider nicht das, was ich mir erhofft hatte...
Weißt du denn zufällig, ob es eine "neue" Methode gibt, den Syncstatus abzufragen?
Freundliche Grüße
Alex
Anzeige
AW: Dateiupload als Eventtrigger
18.08.2020 16:36:29
Mullit
Hallo Alex,
tut mir leid, da kann ich auch nix zu sagen, Du müsstest Dir nochmal alle Events anschauen, da gibt's noch die PivotTableSync-Events, die QueryTable-Events oder auch das SheetTableUpdate-Event für Datentabellen in den neueren xl-Vers., aber Du könntest viell. Deine erfolgten Uploads auch noch über einen Timer checken...aber ich laß mal offen, viell weiß ein anderer da noch was...;-)
Gruß, Mullit
AW: Dateiupload als Eventtrigger
20.08.2020 03:20:16
fcs
Hallo Alex,
die OnTime-Aktionen habe ich dir mal in eine funktionierende Form gebracht.
Mit dem Makro "StartTimeCounter" wird der Counter gestartet
Mit dem Makro "StopTimeCounter" kannst du den Timer jederzeit beenden.
Zur Erfassung von Start/Ende der Kopieraktion habe ich die Timer-Funktion verwendet, da diese auch Bruchteile von Sekunden als Zeit des Tages zur Verfügung stellt.
Wichtig ist, dass die Startzeit des Makros in einer Public Variablen verwaltet wird - so kann man das Makro auch gezielt beenden.
Auch andere Variablen, deren Werte erhalten bleiben sollen bzw. bei jedem Durchlauf hochgezählt werden sollen, müssen als Public deklariert werden.
LG
Franz
Nachfolgend der Makro-Code
'Code unter "DieseArbeitsmappe"
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Wenn Datei geschlossen wird während OnTime noch aktiv ist, dann OnTime beenden
Call StopTimeCounter
End Sub
Public Sub Workbook_Open()
Call StartTimeCounter
End Sub
'Code in einem allgemeinen Modul
Option Explicit
Public lv_createfile As Double
Public lv_standort As Double
Public lv_lfdnr_offset As Double
Public lv_lfdnr As Double
Public lv_zeile As Double
Public lv_maxcount As Double
Public datExitTime As Date
Public datNextStart As Date
Public Sub StartTimeCounter()
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
datExitTime = Now + TimeSerial(Hour:=0, Minute:=5, Second:=0) 'Wie lange soll _
das Programm max. laufen?
lv_zeile = 2
Call prcCreateFile
End Sub
Public Sub prcCreateFile()
Dim fso As Object
Dim strFileFrom As String
Dim strFileTo As String
Dim strZiel As String
Dim filename As String
Dim dblStart As Double
Dim dblEnde As Double
Dim dblDatum As Double
On Error GoTo MyErrorHandler
dblDatum = Date
dblStart = VBA.Timer
Set fso = CreateObject("Scripting.FileSystemObject")
lv_lfdnr = lv_standort + lv_lfdnr_offset + lv_createfile
'ThisWorkbook.SaveCopyAs "C:\Zielverzeichnis\" & _
Format(lv_lfdnr, "000000000") & _
"_" & _
Format(Now, "YYMMDD_HHMMSS") & _
".xlsx"
strZiel = "C:\Zielverzeichnis\"
strZiel = "C:\Users\Acer\OneDrive\Alex\" '              - anpassen !!!!!
strFileFrom = strZiel & "XXX.txt"
strFileFrom = strZiel & "Vorlage.xlsx" '                    - anpassen !!!!!
filename = Format(lv_lfdnr, "000000000") & "_" & Format(Now, "YYMMDD_HHMMSS") _
& ".xlsx"                'ggf - anpassen !!!!!
strFileTo = strZiel & filename
fso.copyfile strFileFrom, strFileTo
dblEnde = VBA.Timer
With ThisWorkbook.Worksheets("Test")
.Cells(lv_zeile, 1).Value = dblDatum + dblStart / 86400
.Cells(lv_zeile, 2).Value = dblDatum + dblEnde / 86400
.Cells(lv_zeile, 3).Value = dblEnde - dblStart
.Cells(lv_zeile, 4).Value = filename
End With
lv_createfile = lv_createfile + 1
lv_zeile = lv_zeile + 1
Set fso = Nothing
If Now > datExitTime Then
MsgBox "Zeit ist abgelaufen", vbOKOnly, "Dateien im Minutentakt erstellen"
lv_zeile = 0
ElseIf lv_createfile >= lv_maxcount Then
MsgBox "maximale Anzahl Dateien wurde erstellt", vbOKCancel, _
"Dateien im Minutentakt erstellen"
lv_zeile = 0
Else
datNextStart = Now + TimeSerial(Hour:=0, Minute:=1, Second:=0) 'nächster Start _
des Makros
Application.OnTime datNextStart, "prcCreateFile"
End If
Exit Sub
MyErrorHandler:
MsgBox "Fehler-Nr.: " & Err.Number & vbLf & Err.Description, vbOKOnly, _
"Fehler im Makro prcCreateFile"
End Sub
Public Sub StopTimeCounter()
lv_zeile = 0
On Error Resume Next
Application.OnTime datNextStart, "prcCreateFile", Schedule:=False
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige